/*
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;
}
syntax highlighted by Code2HTML, v. 0.9.1