GNU Octave  4.2.1
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-2017 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 #if defined (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 
41  Note that the order of arguments for the Visual Fortran function
42  signature is the same as for gfortran and f2c only becuase there is
43  a single assumed size character string argument. Visual Fortran
44  inserts the length after each character string argument, f2c appends
45  all length arguments at the end of the parameter list, and gfortran
46  appends length arguments for assumed size character strings to the
47  end of the list (ignoring others). */
48 
49 F77_RET_T
50 #if defined (F77_USES_CRAY_CALLING_CONVENTION)
51 F77_FUNC (xstopx, XSTOPX) (octave_cray_ftn_ch_dsc desc)
52 #else
53 F77_FUNC (xstopx, XSTOPX) (const char *s, F77_CHAR_ARG_LEN_TYPE slen)
54 #endif
55 {
56 #if defined (F77_USES_CRAY_CALLING_CONVENTION)
57  const char *s = desc.const_ptr = ptr_arg;
58  unsigned long slen = desc.mask.len;
59 #endif
60 
62 
63  /* Skip printing message if it is just a single blank character. */
64  if (s && slen > 0 && ! (slen == 1 && *s == ' '))
65  (*current_liboctave_error_handler) ("%.*s", slen, s);
66 
68 
69  F77_NORETURN (0)
70 }
OCTAVE_NORETURN liboctave_error_handler current_liboctave_error_handler
Definition: lo-error.c:38
int f77_exception_encountered
Definition: f77-extern.cc:35
s
Definition: file-io.cc:2682
void octave_jump_to_enclosing_context(void)
Definition: cquit.c:47
F77_RET_T F77_FUNC(xstopx, XSTOPX) const
Definition: f77-fcn.c:53