GNU Octave  4.0.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
f77-fcn.c
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 1996-2015 John W. Eaton
4 
5 This file is part of Octave.
6 
7 Octave is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 3 of the License, or (at your
10 option) any later version.
11 
12 Octave is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16 
17 You should have received a copy of the GNU General Public License
18 along with Octave; see the file COPYING. If not, see
19 <http://www.gnu.org/licenses/>.
20 
21 */
22 
23 #ifdef HAVE_CONFIG_H
24 #include <config.h>
25 #endif
26 
27 #include <stdlib.h>
28 #include <string.h>
29 
30 #include "f77-fcn.h"
31 #include "quit.h"
32 #include "lo-error.h"
33 
34 /* All the STOP statements in the Fortran routines have been replaced
35  with a call to XSTOPX.
36 
37  XSTOPX jumps back to the entry point for the Fortran function that
38  called us. Then the calling function should do whatever cleanup
39  is necessary. */
40 
42 #if defined (F77_USES_CRAY_CALLING_CONVENTION)
43 F77_FUNC (xstopx, XSTOPX) (octave_cray_ftn_ch_dsc desc)
44 #elif defined (F77_USES_VISUAL_FORTRAN_CALLING_CONVENTION)
45 F77_FUNC (xstopx, XSTOPX) (const char *s, int slen)
46 #else
47 F77_FUNC (xstopx, XSTOPX) (const char *s, long slen)
48 #endif
49 {
50 #if defined (F77_USES_CRAY_CALLING_CONVENTION)
51  const char *s = desc.const_ptr = ptr_arg;
52  unsigned long slen = desc.mask.len;
53 #endif
54 
56 
57  /* Skip printing message if it is just a single blank character. */
58  if (s && slen > 0 && ! (slen == 1 && *s == ' '))
59  (*current_liboctave_error_handler) ("%.*s", slen, s);
60 
62 
63  F77_NORETURN (0)
64 }
int F77_FUNC(xstopx, XSTOPX) const
Definition: f77-fcn.c:47
int f77_exception_encountered
Definition: f77-extern.cc:35
void octave_jump_to_enclosing_context(void)
Definition: cquit.c:47
liboctave_error_handler current_liboctave_error_handler
Definition: lo-error.c:38
#define F77_RET_T
Definition: f77-fcn.h:264
#define F77_NORETURN(retval)
Definition: f77-fcn.h:270