abort_()
{
fprintf(stderr, "Fortran abort routine called\n");
f_exit();
_cleanup();
abort();
}
Variant UnaryOpExpression::eval(VariableEnvironment &env) const {
if (m_op == '@') {
Silencer s;
s.enable();
return m_exp->eval(env);
} else if (m_op == T_ISSET || m_op == T_EMPTY) {
return m_exp->exist(env, m_op);
}
Variant exp(m_exp ? m_exp->eval(env) : null_variant);
SET_LINE;
switch (m_op) {
case T_CLONE: return f_clone(exp);
case '+': return +exp;
case '-': return negate(exp);
case '!': return !exp;
case '~': return ~exp;
case T_INT_CAST: return toInt64(exp);
case T_DOUBLE_CAST: return toDouble(exp);
case T_STRING_CAST: return toString(exp);
case T_ARRAY_CAST: return toArray(exp);
case T_OBJECT_CAST: return toObject(exp);
case T_BOOL_CAST: return toBoolean(exp);
case T_UNSET_CAST: return unset(exp);
case T_EXIT: return f_exit(exp);
case T_PRINT: return print(exp.toString());
case T_EVAL: return HPHP::eval(&env, env.currentObject(), exp);
default:
ASSERT(false);
return Variant();
}
}
void
s_paus(char *s, long int n)
{
int i;
fprintf(stderr, "PAUSE ");
if(n > 0)
for(i = 0; i<n ; ++i)
putc(*s++, stderr);
fprintf(stderr, " statement executed\n");
if( isatty(fileno(stdin)) ) {
fprintf(stderr, "To resume execution, type go. "
"Any other input will terminate job.\n");
if( getchar()!='g' || getchar()!='o' || getchar()!='\n' ) {
fprintf(stderr, "STOP\n");
f_exit();
exit(0);
}
} else {
fprintf(stderr, "To resume execution, execute a "
" kill -%d %d command\n", PAUSESIG, getpid() );
signal(PAUSESIG, waitpause);
pause();
}
fprintf(stderr, "Execution resumes after PAUSE.\n");
}
f77_abort( err_val, act_core )
{
char first_char, *env_var;
int core_dump;
env_var = getenv("f77_dump_flag");
first_char = (env_var == NULL) ? 0 : *env_var;
signal(SIGILL, SIG_DFL);
sigsetmask(0); /* don't block */
/* see if we want a core dump:
first line checks for signals like hangup - don't dump then.
second line checks if -lg specified to ld (e.g. by saying
-g to f77) and checks the f77_dump_flag var. */
core_dump = ((nargs() != 2) || act_core) &&
( (_lg_flag && (first_char != 'n')) || first_char == 'y');
if( !core_dump )
fprintf(units[STDERR].ufd,"*** Execution terminated\n");
f_exit();
_cleanup();
if( nargs() ) errno = err_val;
else errno = -2; /* prior value will be meaningless,
so set it to undefined value */
if( core_dump ) abort();
else exit( errno );
}
exit_(integer *rc)
#endif
{
#ifdef NO_ONEXIT
f_exit();
#endif
exit(*rc);
}
int execute_modifier(int mod) {
int success = 1;
switch(mod) {
case F_EXIT:
success = f_exit();
break;
case F_COPY:
success = f_copy();
break;
case F_CUT:
success = f_cut();
break;
case F_PASTE:
success = f_paste();
break;
case F_FIND:
success = f_find();
break;
case F_GOTO:
success = f_goto();
break;
case F_HELP:
success = f_help();
break;
case F_MORE:
success = f_more();
break;
case F_NEW:
success = f_new();
break;
case F_OPEN:
success = f_open();
break;
case F_NEXTPAGE:
success = f_nextpage();
break;
case F_PREVPAGE:
success = f_prevpage();
break;
case F_RUN:
success = f_run();
break;
case F_SAVE:
success = f_save();
break;
case F_SAVEAS:
success = f_saveas();
break;
case F_UNDO:
success = f_undo();
break;
default:
success = 0; /* Don't want the program to close for any other key */
break;
}
return success;
}
static void s_1paus(FILE *fin)
{
fprintf(stderr,
"To resume execution, type go. Other input will terminate the job.\n");
fflush(stderr);
if( getc(fin)!='g' || getc(fin)!='o' || getc(fin)!='\n' ) {
fprintf(stderr, "STOP\n");
f_exit();
exit(0);
}
}
int
main(int argc, char **argv, char **arge)
{
xargc = argc;
xargv = argv;
signal(SIGFPE, sigfdie); /* ignore underflow, enable overflow */
signal(SIGIOT, sigidie);
MAIN__();
f_exit();
return 0;
}
static void
sigdie(char *s)
{
/* print error message, then clear buffers */
fflush(stderr);
fprintf(stderr, "%s\n", s);
f_exit();
fflush(stderr);
/* now get a core */
signal(SIGIOT, 0);
abort();
}
s_1paus(FILE *fin)
#endif
{
fprintf(stderr,
"To resume execution, type go. Other input will terminate the job.\n");
fflush(stderr);
if( getc(fin)!='g' || getc(fin)!='o' || getc(fin)!='\n' ) {
fprintf(stderr, "STOP\n");
#ifdef NO_ONEXIT
f_exit();
#endif
exit(0);
}
}
void sig_die(register char *s, int kill)
#endif
{
/* print error message, then clear buffers */
fprintf(stderr, "%s\n", s);
/* PAK 09May00 just use standard exit - missing definition of gRecoverToConsole */
/* IMT 13Aug97 MacOS recovers to console */
/* #if defined(TPM_F2C) || defined(SPM_F2C) || defined(CW_F2C_MAC) || defined(CW_F2C_WIN32) */
/* fflush(stderr); */
/* fflush(stdout); */
/* longjmp( gRecoverToConsole, 1 ); */
/* #else */
if(kill)
{
fflush(stderr);
f_exit();
fflush(stderr);
/* now get a core */
#ifdef SIGIOT
signal(SIGIOT, SIG_DFL);
#endif
abort();
}
else {
#ifdef NO_ONEXIT
f_exit();
#endif
exit(1);
}
/* TPM, SPM, and CW */
/* #endif */
}
void sig_die(register char *s, int kill)
#endif
{
/* print error message, then clear buffers */
fprintf(stderr, "%s\n", s);
if(kill)
{
fflush(stderr);
f_exit();
fflush(stderr);
/* now get a core */
#ifdef SIGIOT
signal(SIGIOT, SIG_DFL);
#endif
abort();
}
else {
#ifdef NO_ONEXIT
f_exit();
#endif
exit(1);
}
}
int
main (int argc, char **argv)
{
f_setarg (argc, argv);
f_setsig ();
f_init ();
#ifndef NO_ONEXIT
ONEXIT (f_exit);
#endif
MAIN__ ();
#ifdef NO_ONEXIT
f_exit ();
#endif
exit (0); /* exit(0) rather than return(0) to bypass Cray bug */
return 0; /* For compilers that complain of missing return values; */
/* others will complain that this is unreachable code. */
}
void sig_die(register char *s, int kill)
#endif
{
/* print error message, then clear buffers */
fprintf(stderr, "%s\n", s);
fflush(stderr);
f_exit();
fflush(stderr);
if (kill)
{
/* now get a core */
signal(SIGIOT, SIG_DFL);
abort();
}
else
exit(1);
}
int s_stop(char *s, ftnlen n)
#endif
{
int i;
if(n > 0)
{
fprintf(stderr, "STOP ");
for(i = 0; i<n ; ++i)
putc(*s++, stderr);
fprintf(stderr, " statement executed\n");
}
#ifdef NO_ONEXIT
f_exit();
#endif
exit(0);
return 0; /* NOT REACHED */
}
s_1paus(FILE *fin)
#endif
{
fprintf(stderr,
"To resume execution, type go. Other input will terminate the job.\n");
fflush(stderr);
if( getc(fin)!='g' || getc(fin)!='o' || getc(fin)!='\n' ) {
fprintf(stderr, "STOP\n");
#ifdef NO_ONEXIT
f_exit();
#endif
/* IMT 10Sep95 Use jump buffer to recover to console instead of exit() */
#if defined(TPM_F2C) || defined(SPM_F2C) || defined(CW_F2C_MAC) || defined(CW_F2C_WIN32)
longjmp( gRecoverToConsole, 1 );
#else
exit(0);
#endif /* Macintosh compilers and CW Win32 */
}
}
int s_stop(char *s, ftnlen n)
#endif
{
int i;
if(n > 0)
{
fprintf(stderr, "STOP ");
for(i = 0; i<n ; ++i)
putc(*s++, stderr);
fprintf(stderr, " statement executed\n");
}
#ifdef NO_ONEXIT
f_exit();
#endif
exit(0);
/* We cannot avoid (useless) compiler diagnostics here: */
/* some compilers complain if there is no return statement, */
/* and others complain that this one cannot be reached. */
return 0; /* NOT REACHED */
}
main(int argc, char **argv)
#endif
{
xargc = argc;
xargv = argv;
signal1(SIGFPE, sigfdie); /* ignore underflow, enable overflow */
#ifdef SIGIOT
signal1(SIGIOT, sigidie);
#endif
#ifdef SIGTRAP
signal1(SIGTRAP, sigtrdie);
#endif
#ifdef SIGQUIT
if(signal1(SIGQUIT,sigqdie) == SIG_IGN)
signal1(SIGQUIT, SIG_IGN);
#endif
if(signal1(SIGINT, sigindie) == SIG_IGN)
signal1(SIGINT, SIG_IGN);
signal1(SIGTERM,sigtdie);
#ifdef pdp11
ldfps(01200); /* detect overflow as an exception */
#endif
f_init();
#ifndef NO_ONEXIT
ONEXIT(f_exit);
#endif
MAIN__();
#ifdef NO_ONEXIT
f_exit();
#endif
exit(0); /* exit(0) rather than return(0) to bypass Cray bug */
return 0; /* For compilers that complain of missing return values; */
/* others will complain that this is unreachable code. */
}
Variant f_die(const Variant& status /* = null_variant */) {
return f_exit(status);
}
void exit_(integer *rc)
{
f_exit();
exit(*rc);
}
Variant f_die(CVarRef status /* = null_variant */) {
return f_exit(status);
}
