GNU Octave  9.1.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
f77-fcn.c
Go to the documentation of this file.
1 ////////////////////////////////////////////////////////////////////////
2 //
3 // Copyright (C) 1996-2024 The Octave Project Developers
4 //
5 // See the file COPYRIGHT.md in the top-level directory of this
6 // distribution or <https://octave.org/copyright/>.
7 //
8 // This file is part of Octave.
9 //
10 // Octave is free software: you can redistribute it and/or modify it
11 // under the terms of the GNU General Public License as published by
12 // the Free Software Foundation, either version 3 of the License, or
13 // (at your option) any later version.
14 //
15 // Octave is distributed in the hope that it will be useful, but
16 // WITHOUT ANY WARRANTY; without even the implied warranty of
17 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 // GNU General Public License for more details.
19 //
20 // You should have received a copy of the GNU General Public License
21 // along with Octave; see the file COPYING. If not, see
22 // <https://www.gnu.org/licenses/>.
23 //
24 ////////////////////////////////////////////////////////////////////////
25 
26 #if defined (HAVE_CONFIG_H)
27 # include "config.h"
28 #endif
29 
30 #include <stdlib.h>
31 #include <string.h>
32 
33 #include "f77-fcn.h"
34 #include "quit.h"
35 #include "lo-error.h"
36 
37 /* All the STOP statements in the Fortran routines have been replaced
38  with a call to XSTOPX.
39 
40  XSTOPX calls the liboctave error handler. In the Octave interpreter
41  we set this to a function that throws an exception and transfers
42  control to the enclosing try/catch block. That is typically at the
43  top-level REPL. */
44 
46 F77_FUNC (xstopx, XSTOPX) (F77_CONST_CHAR_ARG_DEF (s_arg, len)
48 {
49  const char *s = F77_CHAR_ARG_USE (s_arg);
50  size_t slen = F77_CHAR_ARG_LEN_USE (s_arg, len);
51 
52  /* Skip printing message if it is just a single blank character. */
53  if (! (s && slen > 0 && ! (slen == 1 && *s == ' ')))
54  {
55  s = "unknown error in fortran subroutine";
56  slen = strlen (s);
57  }
58 
59  (*current_liboctave_error_handler) ("%.*s", (int) slen, s);
60 
61  F77_NORETURN (0)
62 }
F77_RET_T F77_FUNC(xstopx, XSTOPX)
Definition: f77-fcn.c:46
F77_RET_T(F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, const F77_INT &, const F77_INT &, const F77_INT &, F77_INT &, F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, F77_DBLE *, F77_DBLE *, const F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, const F77_INT &, F77_DBLE *, F77_INT *, F77_INT &F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL)
T::size_type strlen(const typename T::value_type *str)
Definition: oct-string.cc:88
F77_RET_T const F77_INT &info F77_CHAR_ARG_LEN_DEF(len))
Definition: xerbla.cc:63
F77_RET_T len
Definition: xerbla.cc:61