/*
 * Copyright (C) 1995-1997 Christopher D. Granz
 *
 * This header may not be removed.
 *
 * Refer to the file "License" included in this package for further
 * information and before using any of the following.
 */

#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <unistd.h>
#include <fcntl.h>

#include "emi.h"


/*
 * Globals
 */
extern EM_VALUE *                                                pStack;
extern EM_VALUE *                                             pStackEnd;
extern EM_VALUE *                                       pInterpStackPos;
extern EM_VALUE *                                        pVarStackBegin;
extern EM_VALUE *                                          pVarStackPos;


/*
 * Tables
 */
const struct em_extern_func_type                      emefCFuncTable[] =
{
#if 0
    { _lalloc,                  "lalloc",
      2,  { TYPE_INT, TYPE_INT },
      1,  { TYPE_ARRAY }                                   },
#endif
    { _lnullobj,                "lnullobj",
      1,  { TYPE_OBJECT },
      1,  { TYPE_INT }                                     },

    { _lobjtype,                "lobjtype",
      1,  { TYPE_OBJECT },
      1,  { TYPE_INT }                                     },

    { _lvstacksize,             "lvstacksize",
      0,  { },
      1,  { TYPE_INT }                                     },

    { _listacksize,             "listacksize",
      0,  { },
      1,  { TYPE_INT }                                     },

    { _lnumbfuncargs,           "lnumbfuncargs",
      1,  { TYPE_INT },
      1,  { TYPE_INT }                                     },

    { _lnumfuncargs,            "lnumfuncargs",
      1,  { TYPE_INT },
      1,  { TYPE_INT }                                     },

    { _lcoredump,               "lcoredump",
      0,  { },
      1,  { TYPE_INT }                                     },

    { _lopentfile,              "lopentfile",
      1,  { TYPE_STRING },
      1,  { TYPE_OBJECT }                                  },

    { _lclosefile,              "lclosefile",
      1,  { TYPE_OBJECT },
      1,  { TYPE_INT }                                     },

    { _lout,                    "out",
      1,  { TYPE_STRING },
      0,  { }                                              },

    { NULL,                     NULL,
      0,  { },
      0,  { }                                              }
};


/*
 * Functions
 */

/*
 * Utility used by almost all the builtin functions.  Gets a number of
 * values off the interpreter stack.
 */
#define p                                        ( pInterpStackPos - i )

void em_get_values( long lArgC, ... )
{
    va_list vlArgs;
    int i;

    VA_START( vlArgs, lArgC );

    for ( i = 1; i <= lArgC; i++ )
    {
        switch ( VA_ARG( vlArgs, long ) )
        {
          case 0          :
              *VA_ARG( vlArgs, EM_VALUE ** )  = p;
              break;

          case TYPE_INT   :
              *VA_ARG( vlArgs, long * )       = p->u.lInt;
              break;

          case TYPE_FLOAT :
              *VA_ARG( vlArgs, double * )     = p->u.dFloat;
              break;

          case TYPE_STRING:
              *VA_ARG( vlArgs, char ** )      = p->u.pString->pString;
              break;

          case TYPE_OBJECT:
              *VA_ARG( vlArgs, EM_OBJECT ** ) = p->u.pObject;
              break;
        }
    }

    interp_stack_pop( lArgC );
    VA_END( vlArgs );
}

#undef p


/*
 * int lnullobj( object o );
 *
 * Standard langauge function.
 *
 *
 * Returns 1 the object o is null, otherwise 0 is returned.
 */
void _lnullobj( void )
{
    EM_VALUE v;
    EM_OBJECT *pParam1;

    em_get_values( 1, TYPE_OBJECT, &pParam1 );
    v.iType       = TYPE_INT;
    v.u.lInt      = ( pParam1->pRealObject == NULL ? 1L : 0L );
    interp_stack_push( &v );
}


/*
 * int lobjtype( object o );
 *
 * Standard langauge function.
 *
 *
 * Returns the type of the object o, as an integer.  Will return 0 if
 * o is null.
 */
void _lobjtype( void )
{
    EM_VALUE v;
    EM_OBJECT *pParam1;

    em_get_values( 1, TYPE_OBJECT, &pParam1 );
    v.iType      = TYPE_INT;

    if ( pParam1->pRealObject == NULL )
        v.u.lInt = 0L;
    else
        v.u.lInt = pParam1->iObjectType;

    interp_stack_push( &v );
}


/*
 * int lvstacksize( );
 *
 * Standard langauge function.
 *
 *
 * Returns the maximum possible size of the variable stack.
 */
void _lvstacksize( void )
{
    EM_VALUE v;

    v.iType  = TYPE_INT;
    v.u.lInt = iVarStackSize;
    interp_stack_push( &v );
}


/*
 * int listacksize( );
 *
 * Standard langauge function.
 *
 *
 * Returns the maximum possible size of the interpreter stack.
 */
void _listacksize( void )
{
    EM_VALUE v;

    v.iType  = TYPE_INT;
    v.u.lInt = iInterpStackSize;
    interp_stack_push( &v );
}


/*
 * int lnumbfuncargs( int i );
 *
 * Standard langauge function.
 *
 *
 * Returns the number of arguments the builtin function referenced
 * by i expects.
 */
void _lnumbfuncargs( void )
{
    EM_VALUE v;
    int i;
    long lParam1;

    em_get_values( 1, TYPE_INT, &lParam1 );
    v.iType      = TYPE_INT;

    for ( i = 0; emefCFuncTable[i].pName != NULL; i++ );

    if ( lParam1 < 0 || lParam1 >= i )
        v.u.lInt = -1L;
    else
        v.u.lInt = emefCFuncTable[lParam1].iNumArgs;

    interp_stack_push( &v );
}


/*
 * int lnumfuncargs( int i );
 *
 * Standard langauge function.
 *
 *
 * Returns the number of arguments the user function referenced by
 * i expects.
 */
void _lnumfuncargs( void )
{
    EM_VALUE v;
    long lParam1;

    em_get_values( 1, TYPE_INT, &lParam1 );
    v.iType      = TYPE_INT;

    if ( lParam1 < 0 || lParam1 > siTopFuncIndex )
        v.u.lInt = -1L;
    else
        v.u.lInt = ppFuncs[lParam1]->iNumArgs;

    interp_stack_push( &v );
}


/*
 * int lcoredump( );
 *
 * Standard langauge function.
 *
 *
 * Attemps to create a core image from the current process.  Returns
 * 1 if successful, otherwise 0 is returned.
 */
void _lcoredump( void )
{
    EM_VALUE v;
    pid_t pPid;
    int iError = 1;

    if ( ( pPid = fork( ) ) < 0 )
    {
        iError = 0;
        goto end;
    }

    if ( pPid == 0 )
        abort( );

end:
    v.iType    = TYPE_INT;
    v.u.lInt   = iError;
    interp_stack_push( &v );
}


/*
 * object lopentfile( string sFilename );
 *
 * Standard langauge function.
 *
 *
 * Attemps to open the file sFilename in text mode.  Returns a file
 * object if successful, otherwise a null object is returned.
 */
void _lopentfile( void )
{
    EM_VALUE v;
    char *pParam1;

    em_get_values( 1, TYPE_STRING, &pParam1 );
    v.iType                  = TYPE_OBJECT;
    init_value( &v );
    v.u.pObject->iObjectType = OBJ_TYPE_FILE;
    v.u.pObject->pRealObject = fopen( pParam1, "a+" );
    interp_stack_push( &v );
}


/*
 * int lclosefile( object oFile );
 *
 * Standard langauge function.
 *
 *
 * Closes a file opened by lopentfile() or lopenbfile().  Returns 0 if
 * successful, otherwise -1 is returned.
 */
void _lclosefile( void )
{
    EM_VALUE v;
    EM_OBJECT *pParam1;

    em_get_values( 1, TYPE_OBJECT, &pParam1 );
    v.iType      = TYPE_INT;

    if ( pParam1->iObjectType != OBJ_TYPE_FILE
      || pParam1->pRealObject == NULL )
        v.u.lInt = -1;
    else
        v.u.lInt = ( fclose( pParam1->pRealObject ) < 0 ? -1 : 0 );

    interp_stack_push( &v );
}


/*
 * Temp.
 */
void _lout( void )
{
    char *pParam1;

    em_get_values( 1, TYPE_STRING, &pParam1 );
    printf( "%s", pParam1 );
}


/*
 * End of builtin.c
 */