Logo Search packages:      
Sourcecode: felt version File versions  Download package

miscfunc.c

/*
    This file is part of the FElt finite element analysis package.
    Copyright (C) 1993-2000 Jason I. Gobat and Darren C. Atkinson

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/

/************************************************************************
 * File:    miscfunc.c                                *
 *                                                    *
 * Description:   This file contains the function definitions for various     *
 *          miscellaneous intrinsic functions.              *
 ************************************************************************/

# include <errno.h>
# include <string.h>
# include "debug.h"
# include "error.h"
# include "lexer.h"
# include "coerce.h"
# include "execute.h"
# include "miscfunc.h"
# include "our-stdlib.h"
# include "pathsearch.h"
# include "interactive.h"

# ifndef ReadBufferSize
# define ReadBufferSize 4096
# endif


/************************************************************************
 * Function:      concat_func                               *
 *                                                    *
 * Description:   Pops and concatenates the two descriptors on the top of     *
 *          the stack and places the result on the stack.  The    *
 *          following types are legal for concatenation:          *
 *                                                    *
 *          concat (string, string) -> string (concatenation)     *
 *                                                    *
 *          An attempt is first made to coerce both arguments to  *
 *          string values.                                  *
 ************************************************************************/

int concat_func (n)
    int n;
{
    char       *s1;
    char       *s2;
    descriptor *arg1;
    descriptor *arg2;
    descriptor *result;
    descriptor    temp;
    int           type_error;
    int           length;


    arg2 = pop ( );
    result = top ( );
    temp = *result;
    arg1 = &temp;


    type_error = F_False;
    arg1 = CoerceData (deref (arg1), T_String);
    arg2 = CoerceData (deref (arg2), T_String);


    if (D_Type (arg1) == T_String && D_Type (arg2) == T_String) {
      s1 = *D_String (arg1);
      s2 = *D_String (arg2);
      length = strlen (s1) + strlen (s2) + 1;
      CreateData (result, NULL, NULL, T_String, length);
      strcpy (*D_String (result), s1);
      strcat (*D_String (result), s2);
    } else
      type_error = F_True;


    if (type_error == F_True)
      TypeError ("concat", arg1, arg2, NULL, F_True);


    RecycleData (arg1);
    RecycleData (arg2);
    d_printf ("concat ans =\n");
    d_PrintData (result);

    return type_error == F_True;
}


/************************************************************************
 * Function:      eval_func                                 *
 *                                                    *
 * Description:   Not available yet.                              *
 ************************************************************************/

int eval_func (n)
    int n;
{
    rterror ("eval() function is not available");
    return 1;
}


/************************************************************************
 * Function:      exit_func                                 *
 *                                                    *
 * Description:   Pops the descriptor on the top of the stack and uses it     *
 *          as an exit value for the program.  If a null argument *
 *          is given the zero is used as the return value.  The   *
 *          following types are legal:                      *
 *                                                    *
 *          exit ()            -> nothing (program termination)         *
 *          exit (integer) -> nothing (program termination)       *
 *                                                    *
 *          An attempt is first made to coerce the argument to an *
 *          integer value.                                  *
 ************************************************************************/

int exit_func (n)
    int n;
{
    descriptor *arg;
    descriptor *result;
    descriptor    temp;
    int           type_error;


    result = top ( );
    temp = *result;
    arg = &temp;


    type_error = F_False;
    arg = CoerceData (deref (arg), T_Int);


    switch (D_Type (arg)) {
    case T_Null:
      exit (0);


    case T_Int:
      exit (*D_Int (arg));


    default:
      type_error = F_True;
      break;
    }


    RecycleData (arg);
    return type_error == F_True;
}


/************************************************************************
 * Function:      history_func                                    *
 *                                                    *
 * Description:   Pops the descriptor on the top of the stack and uses it     *
 *          as the number of history items to print.  The following     *
 *          types are legal:                          *
 *                                                    *
 *          history (null)     -> double (number of items printed)      *
 *          history (double) -> double (number of items printed)  *
 *                                                    *
 *          An attempt is first made to coerce the argument to a  *
 *          double value.                                   *
 ************************************************************************/

int history_func (n)
    int n;
{
    descriptor *arg;
    descriptor *result;
    descriptor    temp;
    int           type_error;


    result = top ( );
    temp = *result;
    arg = &temp;


    type_error = F_False;
    arg = CoerceData (deref (arg), T_Double);


    switch (D_Type (arg)) {
    case T_Double:
      CreateData (result, arg, NULL, T_Double);
      *D_Double (result) = print_history ((int) *D_Double (arg));
      break;


    case T_Null:
      CreateData (result, NULL, NULL, T_Double);
      *D_Double (result) = print_history (0);
      break;


    default:
      type_error = F_True;
      break;
    }


    if (type_error == F_True)
      TypeError ("history", arg, NULL, NULL, F_True);


    RecycleData (arg);
    return type_error == F_True;
}


/************************************************************************
 * Function:      include_func                                    *
 *                                                    *
 * Description:   Pops the descriptor on the top of the stack and treats      *
 *          it as the name of a file to include.  The path named by     *
 *          the BURLAP_PATH environment variable is searched for  *
 *          the file.  The result is the full path name of the file     *
 *          that was included.  The following types are legal:    *
 *                                                    *
 *          include (string) -> string (file inclusion)           *
 *                                                    *
 *          An attempt is first made to coerce the argument to a  *
 *          string value.                                   *
 ************************************************************************/

int include_func (n)
    int n;
{
    char    *name;
    static char   *path;
    descriptor    *arg;
    descriptor    *result;
    descriptor     temp;
    int            type_error;


    result = top ( );
    temp = *result;
    arg = &temp;


    type_error = F_False;
    arg = CoerceData (deref (arg), T_String);


    if (D_Type (arg) == T_String) {
      if (!path)
          path = getenv ("BURLAP_PATH");

      name = pathsearch (path, *D_String (arg), ".b", F_True);
      CreateData (result, NULL, NULL, T_String, strlen (name) + 1);
      strcpy (*D_String (result), name);
      RecycleData (arg);

      if (bfinclude (name)) {
          rterror ("unable to include '%s'", name);
          **D_String (result) = 0;
      }

    } else {
      TypeError ("include", arg, NULL, NULL, F_True);
      type_error = F_True;
      RecycleData (arg);
    }

    return type_error == F_True;
}


/************************************************************************
 * Function:      load_func                                 *
 *                                                    *
 * Description:   Not available yet.                              *
 ************************************************************************/

int load_func (n)
    int n;
{
    rterror ("load() function is not available");
    return 1;
}


/************************************************************************
 * Function:      read_func                                 *
 *                                                    *
 * Description:   Reads a line from standard input, creates a string    *
 *          descriptor from it, and places the result on the stack.     *
 *          A null descriptor is returned upon end-of-file.       *
 ************************************************************************/

int read_func (n)
    int n;
{
    descriptor *result;
    char       *ptr;
    char    buffer [ReadBufferSize];


    if (fgets (buffer, sizeof (buffer), stdin) != NULL) {
      result = push ( );
      if (*(ptr = &buffer [strlen (buffer) - 1]) == '\n')
          *ptr = 0;
      CreateData (result, NULL, NULL, T_String, strlen (buffer));
      strcpy (*D_String (result), buffer);

    } else {
      result = push ( );
      D_Type        (result) = T_Null;
      D_Temp        (result) = F_False;
      D_Trapped (result) = F_False;
      D_Pointer (result) = NULL;
    }


    d_printf ("read ans =\n");
    d_PrintData (result);

    return 0;
}


/************************************************************************
 * Function:      reads_func                                *
 *                                                    *
 * Description:   Reads a string from standard input, creates a string  *
 *          descriptor from it, and places the result on the stack.     *
 *          A null descriptor is returned upon end-of-file.       *
 ************************************************************************/

int reads_func (n)
    int n;
{
    descriptor *result;
    char    buffer [ReadBufferSize];


    if (scanf ("%s", buffer) != EOF) {
      result = push ( );
      CreateData (result, NULL, NULL, T_String, strlen (buffer));
      strcpy (*D_String (result), buffer);

    } else {
      result = push ( );
      D_Type        (result) = T_Null;
      D_Temp        (result) = F_False;
      D_Trapped (result) = F_False;
      D_Pointer (result) = NULL;
    }


    d_printf ("reads ans =\n");
    d_PrintData (result);

    return 0;
}


/************************************************************************
 * Function:      save_func                                 *
 *                                                    *
 * Description:   Not available yet.                              *
 ************************************************************************/

int save_func (n)
    int n;
{
    rterror ("save() function is not available");
    return 1;
}


/************************************************************************
 * Function:      system_func                               *
 *                                                    *
 * Description:   Pops the descriptor on the top of the stack and uses it     *
 *          as input to the system() function to execute a command.     *
 *          The result is the return value of the system() function     *
 *          and is pushed on the stack as a double value.  The    *
 *          following types are legal:                      *
 *                                                    *
 *          system (string) -> double (command invocation)        *
 *                                                    *
 *          An attempt is first made to coerce the argument to a  *
 *          string value.                                   *
 ************************************************************************/

int system_func (n)
    int n;
{
    descriptor *arg;
    descriptor *result;
    descriptor    temp;
    int           type_error;


    result = top ( );
    temp = *result;
    arg = &temp;


    type_error = F_False;
    arg = CoerceData (deref (arg), T_String);


    if (D_Type (arg) == T_String) {
      CreateData (result, NULL, NULL, T_Double);
      *D_Double (result) = system (*D_String (arg));
    } else
      type_error = F_True;


    if (type_error == F_True)
      TypeError ("system", arg, NULL, NULL, F_True);


    RecycleData (arg);
    return type_error == F_True;
}


/************************************************************************
 * Function:      type_func                                 *
 *                                                    *
 * Description:   Pops and computes the type of the descriptor on the top     *
 *          of the stack and places the result on the stack.  The *
 *          result is a string descriptor containing the name of  *
 *          type of the argument.                           *
 ************************************************************************/

int type_func (n)
    int n;
{
    descriptor *arg;
    descriptor *result;
    descriptor    temp;


    result = top ( );
    temp = *result;
    arg = &temp;

    arg = deref (arg);
    arg = CollapseMatrix (arg);

    CreateData (result, NULL, NULL, T_String, strlen (D_TypeName (arg) + 1));
    strcpy (*D_String (result), D_TypeName (arg));


    RecycleData (arg);
    d_printf ("type ans =\n");
    d_PrintData (result);

    return 0;
}

Generated by  Doxygen 1.6.0   Back to index