Mercurial > hg > octave-max
changeset 2786:384c41f7a935
[project @ 1997-03-03 21:33:21 by jwe]
| author | jwe |
|---|---|
| date | Mon, 03 Mar 1997 21:37:39 +0000 |
| parents | c15eee2a86e1 |
| children | 650ab15f8954 |
| files | liboctave/DAEFunc.cc liboctave/LP.cc liboctave/Matrix-ext.cc liboctave/NLConst.cc liboctave/NLFunc.cc liboctave/OChangeLog liboctave/ODEFunc.cc liboctave/Objective.cc liboctave/QLD.cc liboctave/QLD.h liboctave/QP.cc liboctave/tmpnam.c liboctave/utils.cc mkpath.c octave-mode.el src/DLList-fi.cc src/Map-i.cc src/Queue.h src/SLList-str.cc src/SLQueue.h src/bogus.cc src/file-info.cc src/file-info.h src/move-if-change src/oct-tilde.h src/terminals.h src/tree.h.old src/user-prefs.cc src/user-prefs.h |
| diffstat | 29 files changed, 0 insertions(+), 4839 deletions(-) [+] |
line wrap: on
line diff
deleted file mode 100644 --- a/liboctave/DAEFunc.cc +++ /dev/null @@ -1,92 +0,0 @@ -// DAEFunc.cc -*- C++ -*- -/* - -Copyright (C) 1992, 1993, 1994, 1995 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if defined (__GNUG__) -#pragma implementation -#endif - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "DAEFunc.h" - -DAEFunc::DAEFunc (void) -{ - fun = 0; - jac = 0; -} - -DAEFunc::DAEFunc (DAERHSFunc f) -{ - fun = f; - jac = 0; -} - -DAEFunc::DAEFunc (DAERHSFunc f, DAEJacFunc j) -{ - fun = f; - jac = j; -} - -DAEFunc::DAEFunc (const DAEFunc& a) -{ - fun = a.fun; - jac = a.jac; -} - -DAEFunc& -DAEFunc::operator = (const DAEFunc& a) -{ - fun = a.fun; - jac = a.jac; - - return *this; -} - -DAEFunc::DAERHSFunc -DAEFunc::function (void) const -{ - return fun; -} - -DAEFunc& -DAEFunc::set_function (DAERHSFunc f) -{ - fun = f; - return *this; -} - -DAEFunc::DAEJacFunc -DAEFunc::jacobian_function (void) const -{ - return jac; -} - -DAEFunc& -DAEFunc::set_jacobian_function (DAEJacFunc j) -{ - jac = j; - return *this; -} -
deleted file mode 100644 --- a/liboctave/LP.cc +++ /dev/null @@ -1,74 +0,0 @@ -// LP.cc -*- C++ -*- -/* - -Copyright (C) 1992, 1993, 1994, 1995 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if defined (__GNUG__) -#pragma implementation -#endif - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "LP.h" - -LP::LP (void) {} - -LP::LP (const Vector& c_arg) : c (c_arg) { } - -LP::LP (const Vector& c_arg, const Bounds& b) : c (c_arg), bnds (b) { } - -LP::LP (const Vector& c_arg, const LinConst& l) : c (c_arg), lc (l) { } - -LP::LP (const Vector& c_arg, const Bounds& b, const LinConst& l) - : c (c_arg), bnds (b), lc (l) { } - -Vector -LP::minimize (void) -{ - double objf; - int inform; - Vector lambda; - return minimize (objf, inform, lambda); -} - -Vector -LP::minimize (double& objf) -{ - int inform; - Vector lambda; - return minimize (objf, inform, lambda); -} - -Vector -LP::minimize (double& objf, int& inform) -{ - Vector lambda; - return minimize (objf, inform, lambda); -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/liboctave/Matrix-ext.cc +++ /dev/null @@ -1,1270 +0,0 @@ -// Extra Matrix manipulations. -*- C++ -*- -/* - -Copyright (C) 1992, 1993, 1994 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -*/ - -#ifdef HAVE_CONFIG_H -#include "config.h" -#endif - -#include <cfloat> - -#include <iostream.h> - -#include "Matrix.h" -#include "mx-inlines.cc" -#include "lo-error.h" -#include "f77-uscore.h" - -// Fortran functions we call. - -extern "C" -{ - int F77_FCN (dgesv) (const int*, const int*, double*, const int*, - int*, double*, const int*, int*); - - int F77_FCN (dgeqrf) (const int*, const int*, double*, const int*, - double*, double*, const int*, int*); - - int F77_FCN (dorgqr) (const int*, const int*, const int*, double*, - const int*, double*, double*, const int*, int*); - - int F77_FCN (dgeev) (const char*, const char*, const int*, double*, - const int*, double*, double*, double*, - const int*, double*, const int*, double*, - const int*, int*, long, long); - - int F77_FCN (dgeesx) (const char*, const char*, - int (*)(double*, double*), const char*, - const int*, double*, const int*, int*, double*, - double*, double*, const int*, double*, double*, - double*, const int*, int*, const int*, int*, - int*, long, long); - - int F77_FCN (dgebal) (const char*, const int*, double*, - const int*, int*, int*, double*, - int*, long, long); - - int F77_FCN (dgebak) (const char*, const char*, const int*, const int*, - const int*, double*, const int*, double*, const int*, - int*, long, long); - - int F77_FCN (dgehrd) (const int*, const int*, const int*, - double*, const int*, double*, double*, - const int*, int*, long, long); - - int F77_FCN (dorghr) (const int*, const int*, const int*, - double*, const int*, double*, double*, - const int*, int*, long, long); - - int F77_FCN (dgesvd) (const char*, const char*, const int*, - const int*, double*, const int*, double*, - double*, const int*, double*, const int*, - double*, const int*, int*, long, long); - - int F77_FCN (dpotrf) (const char*, const int*, double*, const int*, - int*, long); - -// -// fortran functions for generalized eigenvalue problems -// - int F77_FCN (reduce) (const int*, const int*, double*, - const int*, double*, - int*, int*, double*, double*); - - int F77_FCN (scaleg) (const int*, const int*, double*, - const int*, double*, - const int*, const int*, double*, double*, double*); - - int F77_FCN (gradeq) (const int*, const int*, double*, - const int*, double*, - int*, int*, double*, double*); - -/* - * f2c translates complex*16 as - * - * typedef struct { doublereal re, im; } doublecomplex; - * - * and Complex.h from libg++ uses - * - * protected: - * double re; - * double im; - * - * as the only data members, so this should work (fingers crossed that - * things don't change). - */ - - int F77_FCN (zgesv) (const int*, const int*, Complex*, const int*, - int*, Complex*, const int*, int*); - - int F77_FCN (zgeqrf) (const int*, const int*, Complex*, const int*, - Complex*, Complex*, const int*, int*); - - int F77_FCN (zgeesx) (const char*, const char*, int (*)(Complex*), - const char*, const int*, Complex*, const int*, - int*, Complex*, Complex*, const int*, double*, - double*, Complex*, const int*, double*, int*, - int*, long, long); - - int F77_FCN (zgebal) (const char*, const int*, Complex*, const int*, - int*, int*, double*, int*, long, long); - - int F77_FCN (zgebak) (const char*, const char*, const int*, const int*, - const int*, double*, const int*, Complex*, - const int*, int*, long, long); - - int F77_FCN (zgehrd) (const int*, const int*, const int*, Complex*, - const int*, Complex*, Complex*, const int*, - int*, long, long); - - int F77_FCN (zunghr) (const int*, const int*, const int*, Complex*, - const int*, Complex*, Complex*, const int*, - int*, long, long); - - int F77_FCN (zungqr) (const int*, const int*, const int*, Complex*, - const int*, Complex*, Complex*, const int*, int*); - - int F77_FCN (zgeev) (const char*, const char*, const int*, Complex*, - const int*, Complex*, Complex*, const int*, - Complex*, const int*, Complex*, const int*, - double*, int*, long, long); - - int F77_FCN (zgesvd) (const char*, const char*, const int*, - const int*, Complex*, const int*, double*, - Complex*, const int*, Complex*, const int*, - Complex*, const int*, double*, int*, long, long); - - int F77_FCN (zpotrf) (const char*, const int*, Complex*, const int*, - int*, long); -} - -/* - * AEPBALANCE operations - */ - -int -AEPBALANCE::init (const Matrix& a, const char *balance_job) -{ - int a_nc = a.cols (); - if (a.rows () != a_nc) - { - (*current_liboctave_error_handler) ("AEPBALANCE requires square matrix"); - return -1; - } - - int n = a_nc; - -// Parameters for balance call. - - int info; - int ilo; - int ihi; - double *scale = new double [n]; - -// Copy matrix into local structure. - - balanced_mat = a; - - F77_FCN (dgebal) (balance_job, &n, balanced_mat.fortran_vec (), - &n, &ilo, &ihi, scale, &info, 1L, 1L); - -// Initialize balancing matrix to identity. - - balancing_mat = Matrix (n, n, 0.0); - for (int i = 0; i < n; i++) - balancing_mat.elem (i ,i) = 1.0; - - F77_FCN (dgebak) (balance_job, "R", &n, &ilo, &ihi, scale, &n, - balancing_mat.fortran_vec (), &n, &info, 1L, 1L); - - delete [] scale; - - return info; -} - -int -ComplexAEPBALANCE::init (const ComplexMatrix& a, const char *balance_job) -{ - - int n = a.cols (); - -// Parameters for balance call. - - int info; - int ilo; - int ihi; - double *scale = new double [n]; - -// Copy matrix into local structure. - - balanced_mat = a; - - F77_FCN (zgebal) (balance_job, &n, balanced_mat.fortran_vec (), - &n, &ilo, &ihi, scale, &info, 1L, 1L); - -// Initialize balancing matrix to identity. - - balancing_mat = Matrix (n, n, 0.0); - for (int i = 0; i < n; i++) - balancing_mat (i, i) = 1.0; - - F77_FCN (zgebak) (balance_job, "R", &n, &ilo, &ihi, scale, &n, - balancing_mat.fortran_vec (), &n, &info, 1L, 1L); - - delete [] scale; - - return info; -} - -/* - * GEPBALANCE operations - */ - -int -GEPBALANCE::init (const Matrix& a, const Matrix& b, const char *balance_job) -{ - int a_nr = a.rows (); - int a_nc = a.cols (); - int b_nr = b.rows (); - if (a_nr != a_nc || a_nr != b_nr || b_nr != b.cols ()) - { - (*current_liboctave_error_handler) - ("GEPBALANCE requires square matrices of the same size"); - return -1; - } - - int n = a_nc; - -// Parameters for balance call. - - int info; - int ilo; - int ihi; - double *cscale = new double [n]; - double *cperm = new double [n]; - Matrix wk (n, 6, 0.0); - -// Back out the permutations: -// -// cscale contains the exponents of the column scaling factors in its -// ilo through ihi locations and the reducing column permutations in -// its first ilo-1 and its ihi+1 through n locations. -// -// cperm contains the column permutations applied in grading the a and b -// submatrices in its ilo through ihi locations. -// -// wk contains the exponents of the row scaling factors in its ilo -// through ihi locations, the reducing row permutations in its first -// ilo-1 and its ihi+1 through n locations, and the row permutations -// applied in grading the a and b submatrices in its n+ilo through -// n+ihi locations. - -// Copy matrices into local structure. - - balanced_a_mat = a; - balanced_b_mat = b; - -// Initialize balancing matrices to identity. - - left_balancing_mat = Matrix (n, n, 0.0); - for (int i = 0; i < n; i++) - left_balancing_mat (i, i) = 1.0; - - right_balancing_mat = left_balancing_mat; - -// Check for permutation option. - - if (*balance_job == 'P' || *balance_job == 'B') - { - F77_FCN (reduce) (&n, &n, balanced_a_mat.fortran_vec (), - &n, balanced_b_mat.fortran_vec (), &ilo, &ihi, - cscale, wk.fortran_vec ()); - } - else - { - -// Set up for scaling later. - - ilo = 1; - ihi = n; - } - -// Check for scaling option. - - if ((*balance_job == 'S' || *balance_job == 'B') && ilo != ihi) - { - F77_FCN (scaleg) (&n, &n, balanced_a_mat.fortran_vec (), - &n, balanced_b_mat.fortran_vec (), &ilo, &ihi, - cscale, cperm, wk.fortran_vec ()); - } - else - { - -// Set scaling data to 0's. - - for (int tmp = ilo-1; tmp < ihi; tmp++) - { - cscale[tmp] = 0.0; - wk.elem (tmp, 0) = 0.0; - } - } - -// Scaleg returns exponents, not values, so... - - for (int tmp = ilo-1; tmp < ihi; tmp++) - { - cscale[tmp] = pow (2.0, cscale[tmp]); - wk.elem (tmp, 0) = pow (2.0, -wk.elem (tmp, 0)); - } - -// Column permutations/scaling. - - F77_FCN (dgebak) (balance_job, "R", &n, &ilo, &ihi, cscale, &n, - right_balancing_mat.fortran_vec (), &n, &info, 1L, - 1L); - -// Row permutations/scaling. - - F77_FCN (dgebak) (balance_job, "L", &n, &ilo, &ihi, &wk.elem (0, 0), &n, - left_balancing_mat.fortran_vec (), &n, &info, 1L, 1L); - -// XXX FIXME XXX --- these four lines need to be added and debugged. -// GEPBALANCE::init will work without them, though, so here they are. - -#if 0 - if ((*balance_job == 'P' || *balance_job == 'B') && ilo != ihi) - { - F77_FCN (gradeq) (&n, &n, balanced_a_mat.fortran_vec (), - &n, balanced_b_mat.fortran_vec (), &ilo, &ihi, - cperm, &wk.elem (0, 1)); - } -#endif - -// Transpose for aa = cc*a*dd convention... - left_balancing_mat = left_balancing_mat.transpose (); - - delete [] cscale; - delete [] cperm; - - return info; -} - -/* - * CHOL stuff - */ - -int -CHOL::init (const Matrix& a) -{ - int a_nr = a.rows (); - int a_nc = a.cols (); - if (a_nr != a_nc) - { - (*current_liboctave_error_handler) ("CHOL requires square matrix"); - return -1; - } - - char uplo = 'U'; - - int n = a_nc; - int info; - - double *h = dup (a.data (), a.length ()); - - F77_FCN (dpotrf) (&uplo, &n, h, &n, &info, 1L); - - chol_mat = Matrix (h, n, n); - -// If someone thinks of a more graceful way of doing this (or faster for -// that matter :-)), please let me know! - - if (n > 1) - for (int j = 0; j < a_nc; j++) - for (int i = j+1; i < a_nr; i++) - chol_mat.elem (i, j) = 0.0; - - return info; -} - -int -ComplexCHOL::init (const ComplexMatrix& a) -{ - int a_nr = a.rows (); - int a_nc = a.cols (); - if (a_nr != a_nc) - { - (*current_liboctave_error_handler) - ("ComplexCHOL requires square matrix"); - return -1; - } - - char uplo = 'U'; - - int n = a_nc; - int info; - - Complex *h = dup (a.data (), a.length ()); - - F77_FCN (zpotrf) (&uplo, &n, h, &n, &info, 1L); - - chol_mat = ComplexMatrix (h, n, n); - -// If someone thinks of a more graceful way of doing this (or faster for -// that matter :-)), please let me know! - - if (n > 1) - for (int j = 0; j < a_nc; j++) - for (int i = j+1; i < a_nr; i++) - chol_mat.elem (i, j) = 0.0; - - return info; -} - -/* - * HESS stuff - */ - -int -HESS::init (const Matrix& a) -{ - int a_nr = a.rows (); - int a_nc = a.cols (); - if (a_nr != a_nc) - { - (*current_liboctave_error_handler) ("HESS requires square matrix"); - return -1; - } - - char jobbal = 'N'; - char side = 'R'; - - int n = a_nc; - int lwork = 32 * n; - int info; - int ilo; - int ihi; - - double *h = dup (a.data (), a.length ()); - - double *tau = new double [n+1]; - double *scale = new double [n]; - double *z = new double [n*n]; - double *work = new double [lwork]; - - F77_FCN (dgebal) (&jobbal, &n, h, &n, &ilo, &ihi, scale, &info, - 1L, 1L); - - F77_FCN (dgehrd) (&n, &ilo, &ihi, h, &n, tau, work, &lwork, &info, - 1L, 1L); - - copy (z, h, n*n); - - F77_FCN (dorghr) (&n, &ilo, &ihi, z, &n, tau, work, &lwork, &info, - 1L, 1L); - - F77_FCN (dgebak) (&jobbal, &side, &n, &ilo, &ihi, scale, &n, z, &n, - &info, 1L, 1L); - -// We need to clear out all of the area below the sub-diagonal which was used -// to store the unitary matrix. - - hess_mat = Matrix (h, n, n); - unitary_hess_mat = Matrix (z, n, n); - -// If someone thinks of a more graceful way of doing this (or faster for -// that matter :-)), please let me know! - - if (n > 2) - for (int j = 0; j < a_nc; j++) - for (int i = j+2; i < a_nr; i++) - hess_mat.elem (i, j) = 0; - - delete [] tau; - delete [] work; - delete [] scale; - - return info; -} - -int -ComplexHESS::init (const ComplexMatrix& a) -{ - int a_nr = a.rows (); - int a_nc = a.cols (); - if (a_nr != a_nc) - { - (*current_liboctave_error_handler) - ("ComplexHESS requires square matrix"); - return -1; - } - - char job = 'N'; - char side = 'R'; - - int n = a_nc; - int lwork = 32 * n; - int info; - int ilo; - int ihi; - - Complex *h = dup (a.data (), a.length ()); - - double *scale = new double [n]; - Complex *tau = new Complex [n-1]; - Complex *work = new Complex [lwork]; - Complex *z = new Complex [n*n]; - - F77_FCN (zgebal) (&job, &n, h, &n, &ilo, &ihi, scale, &info, 1L, 1L); - - F77_FCN (zgehrd) (&n, &ilo, &ihi, h, &n, tau, work, &lwork, &info, 1L, - 1L); - - copy (z, h, n*n); - - F77_FCN (zunghr) (&n, &ilo, &ihi, z, &n, tau, work, &lwork, &info, 1L, - 1L); - - F77_FCN (zgebak) (&job, &side, &n, &ilo, &ihi, scale, &n, z, &n, &info, - 1L, 1L); - - hess_mat = ComplexMatrix (h,n,n); - unitary_hess_mat = ComplexMatrix (z,n,n); - -// If someone thinks of a more graceful way of doing this (or faster for -// that matter :-)), please let me know! - - if (n > 2) - for (int j = 0; j < a_nc; j++) - for (int i = j+2; i < a_nr; i++) - hess_mat.elem (i, j) = 0; - - delete [] work; - delete [] tau; - delete [] scale; - - return info; -} - -/* - * SCHUR stuff - */ - -static int -select_ana (double *a, double *b) -{ - return (*a < 0.0); -} - -static int -select_dig (double *a, double *b) -{ - return (hypot (*a, *b) < 1.0); -} - -int -SCHUR::init (const Matrix& a, const char *ord) -{ - int a_nr = a.rows (); - int a_nc = a.cols (); - if (a_nr != a_nc) - { - (*current_liboctave_error_handler) ("SCHUR requires square matrix"); - return -1; - } - - char jobvs = 'V'; - char sort; - - if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd') - sort = 'S'; - else - sort = 'N'; - - char sense = 'N'; - - int n = a_nc; - int lwork = 8 * n; - int liwork = 1; - int info; - int sdim; - double rconde; - double rcondv; - - double *s = dup (a.data (), a.length ()); - - double *wr = new double [n]; - double *wi = new double [n]; - double *q = new double [n*n]; - double *work = new double [lwork]; - -// These are not referenced for the non-ordered Schur routine. - - int *iwork = (int *) NULL; - int *bwork = (int *) NULL; - if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd') - { - iwork = new int [liwork]; - bwork = new int [n]; - } - - if (*ord == 'A' || *ord == 'a') - { - F77_FCN (dgeesx) (&jobvs, &sort, select_ana, &sense, &n, s, &n, - &sdim, wr, wi, q, &n, &rconde, &rcondv, work, - &lwork, iwork, &liwork, bwork, &info, 1L, 1L); - } - else if (*ord == 'D' || *ord == 'd') - { - F77_FCN (dgeesx) (&jobvs, &sort, select_dig, &sense, &n, s, &n, - &sdim, wr, wi, q, &n, &rconde, &rcondv, work, - &lwork, iwork, &liwork, bwork, &info, 1L, 1L); - - } - else - { - F77_FCN (dgeesx) (&jobvs, &sort, (void *) 0, &sense, &n, s, - &n, &sdim, wr, wi, q, &n, &rconde, &rcondv, - work, &lwork, iwork, &liwork, bwork, &info, - 1L, 1L); - } - - schur_mat = Matrix (s, n, n); - unitary_mat = Matrix (q, n, n); - - delete [] wr; - delete [] wi; - delete [] work; - delete [] iwork; - delete [] bwork; - - return info; -} - -static int -complex_select_ana (Complex *a) -{ - return a->real () < 0.0; -} - -static int -complex_select_dig (Complex *a) -{ - return (abs (*a) < 1.0); -} - -int -ComplexSCHUR::init (const ComplexMatrix& a, const char *ord) -{ - int a_nr = a.rows (); - int a_nc = a.cols (); - if (a_nr != a_nc) - { - (*current_liboctave_error_handler) - ("ComplexSCHUR requires square matrix"); - return -1; - } - - char jobvs = 'V'; - char sort; - if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd') - sort = 'S'; - else - sort = 'N'; - - char sense = 'N'; - - int n = a_nc; - int lwork = 8 * n; - int info; - int sdim; - double rconde; - double rcondv; - - double *rwork = new double [n]; - -// bwork is not referenced for non-ordered Schur. - - int *bwork = (int *) NULL; - if (*ord == 'A' || *ord == 'D' || *ord == 'a' || *ord == 'd') - bwork = new int [n]; - - Complex *s = dup (a.data (), a.length ()); - - Complex *work = new Complex [lwork]; - Complex *q = new Complex [n*n]; - Complex *w = new Complex [n]; - - if (*ord == 'A' || *ord == 'a') - { - F77_FCN (zgeesx) (&jobvs, &sort, complex_select_ana, &sense, - &n, s, &n, &sdim, w, q, &n, &rconde, &rcondv, - work, &lwork, rwork, bwork, &info, 1L, 1L); - } - else if (*ord == 'D' || *ord == 'd') - { - F77_FCN (zgeesx) (&jobvs, &sort, complex_select_dig, &sense, - &n, s, &n, &sdim, w, q, &n, &rconde, &rcondv, - work, &lwork, rwork, bwork, &info, 1L, 1L); - } - else - { - F77_FCN (zgeesx) (&jobvs, &sort, (void *) 0, &sense, &n, s, - &n, &sdim, w, q, &n, &rconde, &rcondv, work, - &lwork, rwork, bwork, &info, 1L, 1L); - } - - schur_mat = ComplexMatrix (s,n,n); - unitary_mat = ComplexMatrix (q,n,n); - - delete [] w; - delete [] work; - delete [] rwork; - delete [] bwork; - - return info; -} - -ostream& -operator << (ostream& os, const SCHUR& a) -{ - os << a.schur_matrix () << "\n"; - os << a.unitary_matrix () << "\n"; - - return os; -} - -/* - * SVD stuff - */ - -int -SVD::init (const Matrix& a) -{ - int info; - - int m = a.rows (); - int n = a.cols (); - - char jobu = 'A'; - char jobv = 'A'; - - double *tmp_data = dup (a.data (), a.length ()); - - int min_mn = m < n ? m : n; - int max_mn = m > n ? m : n; - - double *u = new double[m*m]; - double *s_vec = new double[min_mn]; - double *vt = new double[n*n]; - - int tmp1 = 3*min_mn + max_mn; - int tmp2 = 5*min_mn - 4; - int lwork = tmp1 > tmp2 ? tmp1 : tmp2; - double *work = new double[lwork]; - - F77_FCN (dgesvd) (&jobu, &jobv, &m, &n, tmp_data, &m, s_vec, u, &m, - vt, &n, work, &lwork, &info, 1L, 1L); - - left_sm = Matrix (u, m, m); - sigma = DiagMatrix (s_vec, m, n); - Matrix vt_m (vt, n, n); - right_sm = Matrix (vt_m.transpose ()); - - delete [] tmp_data; - delete [] work; - - return info; -} - -ostream& -operator << (ostream& os, const SVD& a) -{ - os << a.left_singular_matrix () << "\n"; - os << a.singular_values () << "\n"; - os << a.right_singular_matrix () << "\n"; - - return os; -} - -int -ComplexSVD::init (const ComplexMatrix& a) -{ - int info; - - int m = a.rows (); - int n = a.cols (); - - char jobu = 'A'; - char jobv = 'A'; - - Complex *tmp_data = dup (a.data (), a.length ()); - - int min_mn = m < n ? m : n; - int max_mn = m > n ? m : n; - - Complex *u = new Complex[m*m]; - double *s_vec = new double[min_mn]; - Complex *vt = new Complex[n*n]; - - int lwork = 2*min_mn + max_mn; - Complex *work = new Complex[lwork]; - - int lrwork = 5*max_mn; - double *rwork = new double[lrwork]; - - F77_FCN (zgesvd) (&jobu, &jobv, &m, &n, tmp_data, &m, s_vec, u, &m, - vt, &n, work, &lwork, rwork, &info, 1L, 1L); - - left_sm = ComplexMatrix (u, m, m); - sigma = DiagMatrix (s_vec, m, n); - ComplexMatrix vt_m (vt, n, n); - right_sm = ComplexMatrix (vt_m.hermitian ()); - - delete [] tmp_data; - delete [] work; - - return info; -} - -/* - * DET stuff. - */ - -int -DET::value_will_overflow (void) const -{ - return det[2] + 1 > log10 (DBL_MAX) ? 1 : 0; -} - -int -DET::value_will_underflow (void) const -{ - return det[2] - 1 < log10 (DBL_MIN) ? 1 : 0; -} - -double -DET::coefficient (void) const -{ - return det[0]; -} - -int -DET::exponent (void) const -{ - return (int) det[1]; -} - -double -DET::value (void) const -{ - return det[0] * pow (10.0, det[1]); -} - -int -ComplexDET::value_will_overflow (void) const -{ - return det[2].real () + 1 > log10 (DBL_MAX) ? 1 : 0; -} - -int -ComplexDET::value_will_underflow (void) const -{ - return det[2].real () - 1 < log10 (DBL_MIN) ? 1 : 0; -} - -Complex -ComplexDET::coefficient (void) const -{ - return det[0]; -} - -int -ComplexDET::exponent (void) const -{ - return (int) (det[1].real ()); -} - -Complex -ComplexDET::value (void) const -{ - return det[0] * pow (10.0, det[1].real ()); -} - -/* - * EIG stuff. - */ - -int -EIG::init (const Matrix& a) -{ - int a_nr = a.rows (); - if (a_nr != a.cols ()) - { - (*current_liboctave_error_handler) ("EIG requires square matrix"); - return -1; - } - - int n = a_nr; - - int info; - - char jobvl = 'N'; - char jobvr = 'V'; - - double *tmp_data = dup (a.data (), a.length ()); - double *wr = new double[n]; - double *wi = new double[n]; - Matrix vr (n, n); - double *pvr = vr.fortran_vec (); - int lwork = 8*n; - double *work = new double[lwork]; - - double dummy; - int idummy = 1; - - F77_FCN (dgeev) (&jobvl, &jobvr, &n, tmp_data, &n, wr, wi, &dummy, - &idummy, pvr, &n, work, &lwork, &info, 1L, 1L); - - lambda.resize (n); - v.resize (n, n); - - for (int j = 0; j < n; j++) - { - if (wi[j] == 0.0) - { - lambda.elem (j) = Complex (wr[j]); - for (int i = 0; i < n; i++) - v.elem (i, j) = vr.elem (i, j); - } - else - { - if (j+1 >= n) - { - (*current_liboctave_error_handler) ("EIG: internal error"); - return -1; - } - - for (int i = 0; i < n; i++) - { - lambda.elem (j) = Complex (wr[j], wi[j]); - lambda.elem (j+1) = Complex (wr[j+1], wi[j+1]); - double real_part = vr.elem (i, j); - double imag_part = vr.elem (i, j+1); - v.elem (i, j) = Complex (real_part, imag_part); - v.elem (i, j+1) = Complex (real_part, -imag_part); - } - j++; - } - } - - delete [] tmp_data; - delete [] wr; - delete [] wi; - delete [] work; - - return info; -} - -int -EIG::init (const ComplexMatrix& a) -{ - int a_nr = a.rows (); - if (a_nr != a.cols ()) - { - (*current_liboctave_error_handler) ("EIG requires square matrix"); - return -1; - } - - int n = a_nr; - - int info; - - char jobvl = 'N'; - char jobvr = 'V'; - - lambda.resize (n); - v.resize (n, n); - - Complex *pw = lambda.fortran_vec (); - Complex *pvr = v.fortran_vec (); - - Complex *tmp_data = dup (a.data (), a.length ()); - - int lwork = 8*n; - Complex *work = new Complex[lwork]; - double *rwork = new double[4*n]; - - Complex dummy; - int idummy = 1; - - F77_FCN (zgeev) (&jobvl, &jobvr, &n, tmp_data, &n, pw, &dummy, - &idummy, pvr, &n, work, &lwork, rwork, &info, 1L, - 1L); - - delete [] tmp_data; - delete [] work; - delete [] rwork; - - return info; -} - -/* - * LU stuff. - */ - -LU::LU (const Matrix& a) -{ - int a_nr = a.rows (); - int a_nc = a.cols (); - if (a_nr == 0 || a_nc == 0 || a_nr != a_nc) - { - (*current_liboctave_error_handler) ("LU requires square matrix"); - return; - } - - int n = a_nr; - - int *ipvt = new int [n]; - int *pvt = new int [n]; - double *tmp_data = dup (a.data (), a.length ()); - int info = 0; - int zero = 0; - double b; - - F77_FCN (dgesv) (&n, &zero, tmp_data, &n, ipvt, &b, &n, &info); - - Matrix A_fact (tmp_data, n, n); - - int i; - - for (i = 0; i < n; i++) - { - ipvt[i] -= 1; - pvt[i] = i; - } - - for (i = 0; i < n - 1; i++) - { - int k = ipvt[i]; - if (k != i) - { - int tmp = pvt[k]; - pvt[k] = pvt[i]; - pvt[i] = tmp; - } - } - - l.resize (n, n, 0.0); - u.resize (n, n, 0.0); - p.resize (n, n, 0.0); - - for (i = 0; i < n; i++) - { - p.elem (i, pvt[i]) = 1.0; - - int j; - - l.elem (i, i) = 1.0; - for (j = 0; j < i; j++) - l.elem (i, j) = A_fact.elem (i, j); - - for (j = i; j < n; j++) - u.elem (i, j) = A_fact.elem (i, j); - } - - delete [] ipvt; - delete [] pvt; -} - -ComplexLU::ComplexLU (const ComplexMatrix& a) -{ - int a_nr = a.rows (); - int a_nc = a.cols (); - if (a_nr == 0 || a_nc == 0 || a_nr != a_nc) - { - (*current_liboctave_error_handler) ("ComplexLU requires square matrix"); - return; - } - - int n = a_nr; - - int *ipvt = new int [n]; - int *pvt = new int [n]; - Complex *tmp_data = dup (a.data (), a.length ()); - int info = 0; - int zero = 0; - Complex b; - - F77_FCN (zgesv) (&n, &zero, tmp_data, &n, ipvt, &b, &n, &info); - - ComplexMatrix A_fact (tmp_data, n, n); - - int i; - - for (i = 0; i < n; i++) - { - ipvt[i] -= 1; - pvt[i] = i; - } - - for (i = 0; i < n - 1; i++) - { - int k = ipvt[i]; - if (k != i) - { - int tmp = pvt[k]; - pvt[k] = pvt[i]; - pvt[i] = tmp; - } - } - - l.resize (n, n, 0.0); - u.resize (n, n, 0.0); - p.resize (n, n, 0.0); - - for (i = 0; i < n; i++) - { - p.elem (i, pvt[i]) = 1.0; - - int j; - - l.elem (i, i) = 1.0; - for (j = 0; j < i; j++) - l.elem (i, j) = A_fact.elem (i, j); - - for (j = i; j < n; j++) - u.elem (i, j) = A_fact.elem (i, j); - } - - delete [] ipvt; - delete [] pvt; -} - -/* - * QR stuff. - */ - -QR::QR (const Matrix& a) -{ - int m = a.rows (); - int n = a.cols (); - - if (m == 0 || n == 0) - { - (*current_liboctave_error_handler) ("QR must have non-empty matrix"); - return; - } - - double *tmp_data; - int min_mn = m < n ? m : n; - double *tau = new double[min_mn]; - int lwork = 32*n; - double *work = new double[lwork]; - int info = 0; - - if (m > n) - { - tmp_data = new double [m*m]; - copy (tmp_data, a.data (), a.length ()); - } - else - tmp_data = dup (a.data (), a.length ()); - - F77_FCN (dgeqrf) (&m, &n, tmp_data, &m, tau, work, &lwork, &info); - - delete [] work; - - r.resize (m, n, 0.0); - for (int j = 0; j < n; j++) - { - int limit = j < min_mn-1 ? j : min_mn-1; - for (int i = 0; i <= limit; i++) - r.elem (i, j) = tmp_data[m*j+i]; - } - - lwork = 32*m; - work = new double[lwork]; - - F77_FCN (dorgqr) (&m, &m, &min_mn, tmp_data, &m, tau, work, &lwork, &info); - - q = Matrix (tmp_data, m, m); - - delete [] tau; - delete [] work; -} - -ComplexQR::ComplexQR (const ComplexMatrix& a) -{ - int m = a.rows (); - int n = a.cols (); - - if (m == 0 || n == 0) - { - (*current_liboctave_error_handler) - ("ComplexQR must have non-empty matrix"); - return; - } - - Complex *tmp_data; - int min_mn = m < n ? m : n; - Complex *tau = new Complex[min_mn]; - int lwork = 32*n; - Complex *work = new Complex[lwork]; - int info = 0; - - if (m > n) - { - tmp_data = new Complex [m*m]; - copy (tmp_data, a.data (), a.length ()); - } - else - tmp_data = dup (a.data (), a.length ()); - - F77_FCN (zgeqrf) (&m, &n, tmp_data, &m, tau, work, &lwork, &info); - - delete [] work; - - r.resize (m, n, 0.0); - for (int j = 0; j < n; j++) - { - int limit = j < min_mn-1 ? j : min_mn-1; - for (int i = 0; i <= limit; i++) - r.elem (i, j) = tmp_data[m*j+i]; - } - - lwork = 32*m; - work = new Complex[lwork]; - - F77_FCN (zungqr) (&m, &m, &min_mn, tmp_data, &m, tau, work, &lwork, &info); - - q = ComplexMatrix (tmp_data, m, m); - - delete [] tau; - delete [] work; -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/liboctave/NLConst.cc +++ /dev/null @@ -1,69 +0,0 @@ -// NLConst.cc -*- C++ -*- -/* - -Copyright (C) 1992, 1993, 1994, 1995 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if defined (__GNUG__) -#pragma implementation -#endif - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "NLConst.h" - -NLConst::NLConst (void) : Bounds (), NLFunc () -{ -} - -NLConst::NLConst (int n) : Bounds (n), NLFunc () -{ -} - -NLConst::NLConst (const Vector& l, const NLFunc f, const Vector& u) - : Bounds (l, u), NLFunc (f) -{ -} - -NLConst::NLConst (const NLConst& a) - : Bounds (a.lb, a.ub), NLFunc (a.fun, a.jac) -{ -} - -NLConst& -NLConst::operator = (const NLConst& a) -{ - nb = a.nb; - lb = a.lb; - fun = a.fun; - jac = a.jac; - ub = a.ub; - - return *this; -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/liboctave/NLFunc.cc +++ /dev/null @@ -1,100 +0,0 @@ -// NLFunc.cc -*- C++ -*- -/* - -Copyright (C) 1992, 1993, 1994, 1995 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if defined (__GNUG__) -#pragma implementation -#endif - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "NLFunc.h" - -NLFunc::NLFunc (void) -{ - fun = 0; - jac = 0; -} - -NLFunc::NLFunc (const nonlinear_fcn f) -{ - fun = f; - jac = 0; -} - -NLFunc::NLFunc (const nonlinear_fcn f, const jacobian_fcn j) -{ - fun = f; - jac = j; -} - -NLFunc::NLFunc (const NLFunc& a) -{ - fun = a.function (); - jac = a.jacobian_function (); -} - -NLFunc& -NLFunc::operator = (const NLFunc& a) -{ - fun = a.function (); - jac = a.jacobian_function (); - - return *this; -} - -nonlinear_fcn -NLFunc::function (void) const -{ - return fun; -} - -NLFunc& -NLFunc::set_function (const nonlinear_fcn f) -{ - fun = f; - - return *this; -} - -jacobian_fcn -NLFunc::jacobian_function (void) const -{ - return jac; -} - -NLFunc& -NLFunc::set_jacobian_function (const jacobian_fcn j) -{ - jac = j; - - return *this; -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/liboctave/OChangeLog +++ /dev/null @@ -1,137 +0,0 @@ -Fri Jan 31 01:12:25 1992 John W. Eaton (jwe at andy.che.utexas.edu) - - Changes for GCC2: - ----------------- - - * Most .hP and .ccP files: Remove unnecessary `auto' keyword (this - cruft was added to allow earlier versions of g++ to compile - certain function definitions). - * Remove `inline' qualifiers for functions in .ccP files. - * Pass and return all class objects by reference. - -Wed Dec 18 11:08:15 1991 John W. Eaton (jwe at andy.che.utexas.edu) - - * Pass vector and matrix objects by reference to avoid (I think) a - g++-1.40 bug and get the NLP class working again. I didn't - understand reference types very well when I first wrote this, so - there were lots of problems... I'm sure there are more places - this needs fixing -- for example, the ODE, DAE and SDAE classes - probably need similar changes. - -Mon Aug 19 03:54:59 1991 John W. Eaton (jwe at andy.che.utexas.edu) - - * SDAE.ccP, SDAE.hP: New files that define an ODE + sensitivity - analysis class based on DDASAC. Needs work to have full - functionality. - - * SDAEFunc.ccP SDAEFunc.hP: New files that define a class of - functions to be used by the SDAE class. - -Wed Jul 24 04:01:49 1991 John W. Eaton (jwe at andy.che.utexas.edu) - - * FEGrid.ccP, FEGrid.hP: New files that define a finite element - grid class -- boundaries must be in ascending order and must have - nonzero width, etc. - -Tue Jul 23 01:20:27 1991 John W. Eaton (jwe at andy.che.utexas.edu) - - * Matrix.ccP, Matrix.hP: (rowset, colset) New member functions. - - * DAE.ccP, DAE.hP, DAEFunc.ccP, DAEFunc.hP: New files, analogous - to the ODE files, that define a DAE class. Maybe working. - - * ODE.ccP, ODE.hP: Modify to use new ODEFunc class. - - * ODEFunc.hP, ODEFunc.ccP: New files that define a function class - for the ODE object. - -Mon Jul 22 00:06:36 1991 John W. Eaton (jwe at andy.che.utexas.edu) - - * convert bounds, linear constraint, nonlinear constraint, - objective function, nlp, ode, and collocation weight classes to - generic style of libg++. - - * NLEqn.hP, NLEqn.ccP: New files that define a class for - solving square systems of nonlinear equations. Maybe working. - - * NLFunc.hP, NLFunc.ccP: New files that define a class for - nonlinear functions returning vectors. Modified nl_const class to - use NLFunc objects instead of handling functions with jacobians - directly. Modifed nlp class to use the new definition of nl_const - constructors. - -Sun Jul 21 06:31:39 1991 John W. Eaton (jwe at andy.che.utexas.edu) - - * LinEqn.hP, LinEqn.ccP: New files that define a class for - solving sets of linear equations. Maybe working. - -Thu Jul 18 00:40:59 1991 John W. Eaton (jwe at andy.che.utexas.edu) - - * SVD.hP, SVD.ccP: New files that define an SVD class. Maybe - working. - -Wed Jul 17 05:15:41 1991 John W. Eaton (jwe at andy.che.utexas.edu) - - * Matrix.{h,cc}P: New methods: inverse (a), a.inverse (), - a.determinant (), a.condition_number (). Based on linpack - routines. - - * *.h *.cc Matrix.hP Matrix.ccP: Removed extraneous this-> - references which aren't needed and look ugly. - - * colloc.cc: New private data member `initialized'. Only compute - values for r, q, A, and B when needed and then only if initialized - is false. Set initialized = false when any size/constant data - changes. Reset it to true before returning from init(). - - * Change type of most void foo::bar_set() methods to be of type - foo& and return *this so that they can be chained together: - a.foo().bar().baz(); - - * *.h, but not *.hP: Moved all definitions of functions into .cc - files. Hoping to speed up compilation somewhat. - -Tue Jul 16 08:33:01 1991 John W. Eaton (jwe at andy.che.utexas.edu) - - * *.h: make sure that include files are only included once by - using #ifndef _foo_h / #define _foo_h / ... / #endif _foo_h. - - * nlp.cc: appears to work for user supplied gradient and jacobian - functions. Linear constraints appear to work. - - * Add stream output operators for the <T>Matrix and <T>Vec - classes. - - * Updated the nlp class to handle new definition of the objective - function, bounds, and constraints. - - * New test programs: bounds-test, lin_const-test, and nl_const-test. - - * New classes: - - objective: instead of specifying the objective function - directly, you provide the nlp class with an objective function - object. The user has the option of specifying a gradient - function. - - bounds, lin_const, nl_const: these replace the constraint - object. nl_const allows the user the option of specifying a - jacobian function. - - The nl_const and objective objects should probably both know - how to compute gradient information whether the user supplies - a function or not. - - colloc: collocation object. The test program for this still - needs to be written. - -Sun Jul 14 22:50:51 1991 John W. Eaton (jwe at andy.che.utexas.edu) - - * Have very minimal but mostly working classes for simple matrix - operations (uses some BLAS routines), ordinary differential - equations (based on LSODE), nonlinear programming (based on - NPSOL), and constraint sets (for NLP). - - * About time to start this, since I seem to actually be making - progress on this stuff now. -
deleted file mode 100644 --- a/liboctave/ODEFunc.cc +++ /dev/null @@ -1,98 +0,0 @@ -// ODEFunc.cc -*- C++ -*- -/* - -Copyright (C) 1992, 1993, 1994, 1995 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if defined (__GNUG__) -#pragma implementation -#endif - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "ODEFunc.h" - -ODEFunc::ODEFunc (void) -{ - fun = 0; - jac = 0; -} - -ODEFunc::ODEFunc (ODERHSFunc f) -{ - fun = f; - jac = 0; -} - -ODEFunc::ODEFunc (ODERHSFunc f, ODEJacFunc j) -{ - fun = f; - jac = j; -} - -ODEFunc::ODEFunc (const ODEFunc& a) -{ - fun = a.function (); - jac = a.jacobian_function (); -} - -ODEFunc& -ODEFunc::operator = (const ODEFunc& a) -{ - fun = a.function (); - jac = a.jacobian_function (); - - return *this; -} - -ODEFunc::ODERHSFunc -ODEFunc::function (void) const -{ - return fun; -} - -ODEFunc& -ODEFunc::set_function (ODERHSFunc f) -{ - fun = f; - return *this; -} - -ODEFunc::ODEJacFunc -ODEFunc::jacobian_function (void) const -{ - return jac; -} - -ODEFunc& -ODEFunc::set_jacobian_function (ODEJacFunc j) -{ - jac = j; - return *this; -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/liboctave/Objective.cc +++ /dev/null @@ -1,97 +0,0 @@ -// Objective.cc -*- C++ -*- -/* - -Copyright (C) 1992, 1993, 1994, 1995 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if defined (__GNUG__) -#pragma implementation -#endif - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "Objective.h" - -Objective::Objective (void) -{ - phi = 0; - grad = 0; -} - -Objective::Objective (const objective_fcn obj) -{ - phi = obj; - grad = 0; -} - -Objective::Objective (const objective_fcn obj, const gradient_fcn g) -{ - phi = obj; - grad = g; -} - -Objective::Objective (const Objective& a) -{ - phi = a.phi; - grad = a.grad; -} - -Objective& -Objective::operator = (const Objective& a) -{ - phi = a.phi; - grad = a.grad; - return *this; -} - -objective_fcn -Objective::objective_function (void) const -{ - return phi; -} - -Objective& -Objective::set_objective_function (const objective_fcn obj) -{ - phi = obj; - return *this; -} - -gradient_fcn -Objective::gradient_function (void) const -{ - return grad; -} - -Objective& -Objective::set_gradient_function (const gradient_fcn g) -{ - grad = g; - return *this; -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/liboctave/QLD.cc +++ /dev/null @@ -1,138 +0,0 @@ -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if defined (__GNUG__) -#pragma implementation -#endif - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <cmath> - -#include <iostream.h> - -#include "QLD.h" -#include "dColVector.h" -#include "dMatrix.h" -#include "dRowVector.h" -#include "f77-fcn.h" - -extern "C" -{ - int F77_FCN (qld, QLD) (int&, int&, int&, int&, int&, double*, - double*, double*, double*, double*, double*, - double*, double*, int&, int&, int&, double*, - int&, int*, int&); -} - -ColumnVector -QLD::minimize (double& objf, int& inform) -{ - int n = x.capacity (); - - Matrix A1 = lc.eq_constraint_matrix (); - ColumnVector b1 = lc.eq_constraint_vector (); - - Matrix A2 = lc.ineq_constraint_matrix (); - ColumnVector b2 = lc.ineq_constraint_vector (); - - int me = A1.rows (); - int m = me + A2.rows (); - - cout << "n: " << n << "\n"; - cout << "m: " << m << "\n"; - cout << "me: " << me << "\n"; - - A1.stack (A2); - b1.stack (b2); - - int lwar = n*(3*n + 15)/2 + m + 100; - int liwar = n + 100; - - Array<double> war (lwar); - double *pwar = war.fortran_vec (); - - Array<int> iwar (liwar); - int *piwar = iwar.fortran_vec (); - - iwar.elem (0) = 0; - - Array<double> u (m+n+n + 100); - double *pu = u.fortran_vec (); - - int iout = 0; - - double *px = x.fortran_vec (); - double *ph = H.fortran_vec (); - - cout << x; - cout << H; - cout << c; - - double *pc = 0; - if (c.capacity () > 0) - pc = c.fortran_vec (); - - double *pa = 0; - if (A1.rows () > 0 && A1.columns () > 0) - pa = A1.fortran_vec (); - - double *pb = 0; - if (b1.capacity () > 0) - pb = b1.fortran_vec (); - - ColumnVector xlb = bnds.lower_bounds (); - ColumnVector xub = bnds.upper_bounds (); - if (xlb.capacity () <= 0) - { - xlb.resize (n, -1.0e30); - xub.resize (n, 1.0e30); - } - double *pxl = xlb.fortran_vec (); - double *pxu = xub.fortran_vec (); - - int mmax = m > 0 ? m : 1; - - iprint = 1; - F77_XFCN (qld, QLD, (m, me, mmax, n, n, ph, pc, pa, pb, pxl, pxu, px, - pu, iout, inform, iprint, pwar, lwar, piwar, - liwar)); - - if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in qld"); - else - { - objf = (x.transpose () * H * x) / 2.0; - if (c.capacity () > 0) - objf += c.transpose () * x; - } - - return x; -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
deleted file mode 100644 --- a/liboctave/QLD.h +++ /dev/null @@ -1,100 +0,0 @@ -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if !defined (octave_QLD_h) -#define octave_QLD_h 1 - -#if defined (__GNUG__) -#pragma interface -#endif - -class Matrix; -class ColumnVector; - -#include "QP.h" - -class -QLD : public QP -{ -public: - - QLD (void) - : QP (), iprint (0) { } - - QLD (const ColumnVector& x, const Matrix& H) - : QP (x, H), iprint (0) { } - - QLD (const ColumnVector& x, const Matrix& H, const ColumnVector& c) - : QP (x, H, c), iprint (0) { } - - QLD (const ColumnVector& x, const Matrix& H, const Bounds& b) - : QP (x, H, b), iprint (0) { } - - QLD (const ColumnVector& x, const Matrix& H, const LinConst& lc) - : QP (x, H, lc), iprint (0) { } - - QLD (const ColumnVector& x, const Matrix& H, const ColumnVector& c, - const Bounds& b) - : QP (x, H, c, b), iprint (0) { } - - QLD (const ColumnVector& x, const Matrix& H, const ColumnVector& c, - const LinConst& lc) - : QP (x, H, c, lc), iprint (0) { } - - QLD (const ColumnVector& x, const Matrix& H, const Bounds& b, - const LinConst& lc) - : QP (x, H, b, lc), iprint (0) { } - - QLD (const ColumnVector& x, const Matrix& H, const ColumnVector& c, - const Bounds& b, const LinConst& lc) - : QP (x, H, c, b, lc), iprint (0) { } - - QLD (const QLD& a) - : QP (a.x, a.H, a.c, a.bnds, a.lc), iprint (0) { } - - QLD& operator = (const QLD& a) - { - if (this != &a) - { - QP::operator = (a); - - iprint = a.iprint; - } - return *this; - } - - ~QLD (void) { } - - ColumnVector minimize (double& objf, int& inform); - -private: - - int iprint; -}; - -#endif - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
deleted file mode 100644 --- a/liboctave/QP.cc +++ /dev/null @@ -1,162 +0,0 @@ -// QP.cc -*- C++ -*- -/* - -Copyright (C) 1992, 1993, 1994, 1995 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if defined (__GNUG__) -#pragma implementation -#endif - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "QP.h" - -QP::QP (void) {} - -QP::QP (const Vector& x0, const Matrix& H_arg) : x (x0), H (H_arg) -{ - make_h_symmetric (); -} - -QP::QP (const Vector& x0, const Matrix& H_arg, const Vector& c_arg) - : x (x0), H (H_arg), c (c_arg) -{ - make_h_symmetric (); -} - - -QP::QP (const Vector& x0, const Matrix& H_arg, const Bounds& b) - : x (x0), H (H_arg), bnds (b) -{ - make_h_symmetric (); -} - - -QP::QP (const Vector& x0, const Matrix& H_arg, const LinConst& l) - : x (x0), H (H_arg), lc (l) -{ - make_h_symmetric (); -} - - -QP::QP (const Vector& x0, const Matrix& H_arg, const Vector& c_arg, - const Bounds& b) - : x (x0), H (H_arg), c (c_arg), bnds (b) -{ - make_h_symmetric (); -} - - -QP::QP (const Vector& x0, const Matrix& H_arg, const Vector& c_arg, - const LinConst& l) - : x (x0), H (H_arg), c (c_arg), lc (l) -{ - make_h_symmetric (); -} - - -QP::QP (const Vector& x0, const Matrix& H_arg, const Bounds& b, - const LinConst& l) - : x (x0), H (H_arg), bnds (b), lc (l) -{ - make_h_symmetric (); -} - - -QP::QP (const Vector& x0, const Matrix& H_arg, const Vector& c_arg, - const Bounds& b, const LinConst& l) - : x (x0), H (H_arg), c (c_arg), bnds (b), lc (l) -{ - make_h_symmetric (); -} - -Matrix -QP::make_h_symmetric (void) -{ - return 0.5 * (H + H.transpose ()); -} - -Vector -QP::minimize (void) -{ - double objf; - int inform; - Vector lambda; - return minimize (objf, inform, lambda); -} - -Vector -QP::minimize (double& objf) -{ - int inform; - Vector lambda; - return minimize (objf, inform, lambda); -} - -Vector -QP::minimize (double& objf, int& inform) -{ - Vector lambda; - return minimize (objf, inform, lambda); -} - -Vector -QP::minimize (const Vector& x0) -{ - x = x0; - double objf; - int inform; - Vector lambda; - return minimize (objf, inform, lambda); -} - -Vector -QP::minimize (const Vector& x0, double& objf) -{ - x = x0; - int inform; - Vector lambda; - return minimize (objf, inform, lambda); -} - -Vector -QP::minimize (const Vector& x0, double& objf, int& inform) -{ - x = x0; - Vector lambda; - return minimize (objf, inform, lambda); -} - -Vector -QP::minimize (const Vector& x0, double& objf, int& inform, Vector& lambda) -{ - x = x0; - return minimize (objf, inform, lambda); -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/liboctave/tmpnam.c +++ /dev/null @@ -1,52 +0,0 @@ -/* Copyright (C) 1991, 1993 Free Software Foundation, Inc. -This file is part of the GNU C Library. - -The GNU C Library 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. - -The GNU C Library 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 the GNU C Library; see the file COPYING. If -not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#ifndef HAVE_TMPNAM - -#include <stddef.h> -#include <stdio.h> -#include <string.h> - -extern char *__stdio_gen_tempname (const char *dir, const char *pfx, - int dir_search, size_t *lenptr, - FILE **streamptr); - -/* Generate a unique filename in P_tmpdir. */ -char * -tmpnam (register char *s) -{ - register char *t = __stdio_gen_tempname((const char *) NULL, - (const char *) NULL, 0, - (size_t *) NULL, (FILE **) NULL); - - if (t == NULL) - return NULL; - - if (s != NULL) - (void) strcpy(s, t); - else - s = t; - - return s; -} - -#endif
deleted file mode 100644 --- a/liboctave/utils.cc +++ /dev/null @@ -1,71 +0,0 @@ -// utils.cc -*- C++ -*- -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <csignal> -#include <cstdlib> - -#ifdef HAVE_UNISTD_H -#ifdef HAVE_SYS_TYPES_H -#include <sys/types.h> -#endif -#include <unistd.h> -#endif - -#include "f77-fcn.h" - -// All the STOP statements in the Fortran routines have been replaced -// with a call to XSTOPX, defined in the file libcruft/misc/xstopx.f. -// -// The XSTOPX function calls this function, which will send a SIGINT -// signal to the program that invoked it. -// -// Octave's SIGINT signal handler calls jump_to_top_level(), and the -// user will end up at the top level instead of the shell prompt. -// -// Programs that don't handle SIGINT will be interrupted. - -extern "C" -{ - - volatile void -#if defined (F77_APPEND_UNDERSCORE) - do_stop_ (void) -#else - do_stop (void) -#endif - { - kill (getpid (), SIGINT); - abort (); - } -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/mkpath.c +++ /dev/null @@ -1,87 +0,0 @@ -/* Make all the directories along a path. - Copyright (C) 1992 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs 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 1, or (at your option) -any later version. - -GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ - -/* This program works like mkdir, except that it generates - intermediate directories if they don't exist. This is just like - the `mkdir -p' command on most systems; unfortunately, the mkdir - command on some of the purer BSD systems (like Mt. Xinu) don't have - that option. */ - -#include <sys/types.h> -#include <sys/stat.h> -#include <stdio.h> -#include <errno.h> - -extern int errno; - -char *prog_name; - -int touchy_mkdir (path) - char *path; -{ - struct stat buf; - - /* If PATH already exists and is a directory, return success. */ - if (stat (path, &buf) >= 0 - && (buf.st_mode & S_IFMT) == S_IFDIR) - return 0; - - /* Otherwise, try to make it. If PATH exists but isn't a directory, - this will signal an error. */ - if (mkdir (path, 0777) < 0) - { - fprintf (stderr, "%s: ", prog_name); - perror (path); - return -1; - } - - return 0; -} - -int -main (argc, argv) - int argc; - char **argv; -{ - prog_name = *argv; - - for (argc--, argv++; argc > 0; argc--, argv++) - { - char *path = *argv; - int i; - - /* Stop at each slash in path and try to create the directory. - Skip any initial slash. */ - for (i = (path[0] == '/') ? 1 : 0; path[i]; i++) - if (path[i] == '/') - { - path[i] = '\0'; - if (touchy_mkdir (path) < 0) - goto next_pathname; - path[i] = '/'; - } - - touchy_mkdir (path); - - next_pathname: - ; - } - - return 0; -}
deleted file mode 100644 --- a/octave-mode.el +++ /dev/null @@ -1,346 +0,0 @@ -;; octave-mode.el - major mode for editing Octave source with GNU Emacs -;; -;; This major mode for GNU Emacs provides support for editing Octave -;; source files. It automatically indents for block structures, line -;; continuations (e.g., ...), and comments. The usual paren matching -;; support is included. Indenting for continued matrix expressions is -;; currently not supported. Perhaps it will be in the future. Auto-fill -;; mode seems to actually work! For convient use add something like the -;; following to your .emacs start-up file: -;; -;; (autoload 'octave-mode "octave-mode" "Enter Octave-mode." t) -;; (setq auto-mode-alist (cons '("\\.m$" . octave-mode) auto-mode-alist)) -;; (setq octave-mode-hook '(lambda () (setq fill-column 74))) -;; -;; Enjoy. -;; -;; Last modified Sun Mar 7 17:55:20 1993. -;; -;; This file was modified by John W. Eaton (jwe@che.utexas.edu) from -;; the file matlab-mode.el which is: -;; -;; Copyright (C) 1991 Matthew R. Wette. -;; Everyone is granted permission to copy, modify and redistribute this -;; file provided: -;; 1. All copies contain this copyright notice. -;; 2. All modified copies shall carry a prominant notice stating who -;; made the last modification and the date of such modification. -;; 3. No charge is made for this software or works derived from it. -;; This clause shall not be construed as constraining other software -;; distributed on the same medium as this software, nor is a -;; distribution fee considered a charge. -;; -;; Version 1.01, dated 25Jan91 -;; -;; 25Jan91 by Matt Wette, mwette@csi.jpl.nasa.gov -;; Got indentation of matrix expression to work, I think. Also, -;; added tabs to comment start regular-expression. -;; -;; 14Jan91 by Matt Wette, mwette@csi.jpl.nasa.gov -;; Added functions (ml-unbal-matexp ml-matexp-indent) for matrix -;; expressions. -;; -;; 07Jan91 by Matt Wette, mwette@csi.jpl.nasa.gov -;; Many changes. Seems to work reasonably well. Still would like -;; to add some support for filling in comments and handle continued -;; matrix expressions. Released as Version 1.0. -;; -;; 04Jan91 by Matt Wette, mwette@csi.jpl.nasa.gov -;; Created. Used eiffel.el as a guide. - - -;; Constants used in all Octave-mode buffers. -(defconst octave-indent-level 2 - "*The indentation in Octave-mode.") - -(defconst octave-comment-column 40 - "*The goal comment column in Octave-mode buffers.") - - -;; Syntax Table -(defvar octave-mode-syntax-table nil - "Syntax table used in Octave-mode buffers.") - -(if octave-mode-syntax-table - () - (setq octave-mode-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\\ "." octave-mode-syntax-table) - (modify-syntax-entry ?/ "." octave-mode-syntax-table) - (modify-syntax-entry ?* "." octave-mode-syntax-table) - (modify-syntax-entry ?+ "." octave-mode-syntax-table) - (modify-syntax-entry ?- "." octave-mode-syntax-table) - (modify-syntax-entry ?= "." octave-mode-syntax-table) - (modify-syntax-entry ?< "." octave-mode-syntax-table) - (modify-syntax-entry ?> "." octave-mode-syntax-table) - (modify-syntax-entry ?& "." octave-mode-syntax-table) - (modify-syntax-entry ?| "." octave-mode-syntax-table) - (modify-syntax-entry ?\' "\"" octave-mode-syntax-table) - (modify-syntax-entry ?# "<" octave-mode-syntax-table) - (modify-syntax-entry ?% "<" octave-mode-syntax-table) - (modify-syntax-entry ?\n ">" octave-mode-syntax-table) - (set-syntax-table octave-mode-syntax-table)) - - -;; Abbrev Table -(defvar octave-mode-abbrev-table nil - "Abbrev table used in Octave-mode buffers.") - -(define-abbrev-table 'octave-mode-abbrev-table ()) - - -;; Mode Map -(defvar octave-mode-map () - "Keymap used in octave-mode.") - -(if octave-mode-map - () - (setq octave-mode-map (make-sparse-keymap)) - (define-key octave-mode-map "\r" 'octave-return) - (define-key octave-mode-map "\t" 'octave-indent-line) - (define-key octave-mode-map "\M-;" 'octave-comment) - (define-key octave-mode-map "\C-ct" 'octave-line-type) - (define-key octave-mode-map "\C-ci" 'octave-indent-type) - (define-key octave-mode-map "\M-\r" 'newline)) - - -;; Octave Mode -(defun octave-mode () - "Major mode for editing Octave source files. Version 1.0, 23 Feb 1993. -Will run octave-mode-hook if it is non-nil. Auto-fill-mode seems to work. -Filling does not work (yet). -Special Key Bindings: -\\{octave-mode-map} -Variables: - octave-indent-level Level to indent blocks. - octave-comment-column Goal column for on-line comments. - fill-column Column used in auto-fill (default=70). -Commands: - octave-mode Enter Octave major mode. - octave-return Handle return with indenting. - octave-indent-line Indent line for structure. - octave-comment Add comment to current line. - octave-comment-indent Compute indent for comment. - octave-line-type Tell current line type (for debugging). - octave-indent-type Tell last indent type (for debugging). -To add automatic support put something like the following in your .emacs file: - \(autoload 'octave-mode \"octave-mode\" \"Enter Octave-mode.\" t\) - \(setq auto-mode-alist \(cons '\(\"\\\\.m$\" . octave-mode\) \ -auto-mode-alist\)\) - \(setq octave-mode-hook '\(lambda \(\) \(setq fill-column 74\)\)\)" - (interactive) - (kill-all-local-variables) - (use-local-map octave-mode-map) - (setq major-mode 'octave-mode) - (setq mode-name "Octave") - (setq local-abbrev-table octave-mode-abbrev-table) - (set-syntax-table octave-mode-syntax-table) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "^$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'octave-indent-line) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "[%#][ \t]*") - (make-local-variable 'comment-column) - (setq comment-column 'octave-comment-column) - (make-local-variable 'comment-indent-hook) - (setq comment-indent-hook 'octave-comment-indent) - (make-local-variable 'fill-column) - (setq fill-column default-fill-column) - (run-hooks 'octave-mode-hook)) - - -(defun octave-return () - "Handle carriage return in Octave-mode." - (interactive) - (if (oct-block-end-line) - (octave-indent-line)) - (newline) - (octave-indent-line)) - -(defun octave-comment () - "Add a comment to the following line, or format if one already exists." - (interactive) - (cond - ((oct-empty-line) - (octave-indent-line) - (insert "# ")) - ((oct-comment-line)) - (t - (end-of-line) - (re-search-backward "[^ \t^]" 0 t) - (forward-char) - (delete-horizontal-space) - (if (< (current-column) octave-comment-column) - (indent-to octave-comment-column) - (insert " ")) - (insert "# ")))) - -(defun octave-comment-indent () - "Indent a comment line in Octave-mode." - (oct-calc-indent)) - -(defun octave-indent-line () - "Indent a line in Octave-mode." - (interactive) - (save-excursion - (beginning-of-line) - (delete-horizontal-space) - (indent-to (oct-calc-indent))) - (skip-chars-forward " \t")) - -(defun octave-line-type () - "Display type of current line. Used in debugging." - (interactive) - (cond - ((oct-empty-line) - (message "octave-line-type: empty-line")) - ((oct-comment-line) - (message "octave-line-type: comment-line")) - ((oct-continuation-line) - (message "octave-line-type: continuation-line")) - ((oct-block-beg-end-line) - (message "octave-line-type: block-beg-end-line")) - ((oct-block-beg-line) - (message "octave-line-type: block-beg-line")) - ((oct-block-end-line) - (message "octave-line-type: block-end-line")) - (t - (message "octave-line-type: other")))) - -(defun octave-indent-type () - "Display type of current or previous nonempty line. Used in debugging." - (interactive) - (message (concat "octave-ident-type: " oct-last-indent-type))) - -(defun octave-fill-region (from to &optional justify-flag) - "Fill the region of comments. -Prefix arg (non-nil third arg, if called from program) -means justify as well." - (interactive "r\nP") - (messages "octave-fill-region not implemented yet.")) - -(defvar oct-last-indent-type "unknown" - "String to tell line type.") - -(defun oct-calc-indent () - "Return the appropriate indentation for this line as an int." - (let ((indent 0)) - (save-excursion - (forward-line -1) ; compute indent based on previous - (if (oct-empty-line) ; non-empty line - (re-search-backward "[^ \t\n]" 0 t)) - (cond - ((oct-empty-line) - (setq oct-last-indent-type "empty")) - ((oct-comment-line) - (setq oct-last-indent-type "comment")) - ((oct-continuation-line) - (setq oct-last-indent-type "continuation") - (setq indent (* 2 octave-indent-level))) - ((oct-block-beg-end-line) - (setq oct-last-indent-type "block begin-end")) - ((oct-block-beg-line) - (setq oct-last-indent-type "block begin") - (setq indent octave-indent-level)) - ((oct-unbal-matexp-line) - (setq oct-last-indent-type "unbalanced-matrix-expression") - (setq indent (oct-calc-matexp-indent))) - (t - (setq oct-last-indent-type "other"))) - (setq indent (+ indent (current-indentation))) - (if (= 0 (forward-line -1)) - (if (oct-continuation-line) - (setq indent (- indent (* 2 octave-indent-level)))))) - (if (oct-block-end-line) (setq indent (- indent octave-indent-level))) - (if (< indent 0) (setq indent 0)) - indent)) - - -(defun oct-empty-line () - "Returns t if current line is empty." - (save-excursion - (beginning-of-line) - (looking-at "^[ \t]*$"))) - -(defun oct-comment-line () - "Returns t if current line is an Octave comment line." - (save-excursion - (beginning-of-line) - (skip-chars-forward " \t") - (looking-at "[%#]"))) - -(defun oct-continuation-line () - "Returns t if current line ends in ... and optional comment." - (save-excursion - (beginning-of-line) - (re-search-forward "\\.\\.\\.+[ \t]*\\(%.*\\)?$" (oct-eoln-point) t))) - -(defun oct-eoln-point () - "Returns point for end-of-line in Octave-mode." - (save-excursion - (end-of-line) - (point))) - -(defun oct-block-beg-line () - "Returns t if line contains beginning of Octave block." - (save-excursion - (beginning-of-line) - (looking-at (concat "\\([^%#\n]*[ \t]\\)?" oct-block-beg-kw)))) - -(defconst oct-block-beg-kw "\\(for\\|while\\|if\\|else\\|elseif\\|function\\)" - "Regular expression for keywords which begin blocks in Octave-mode.") - -(defun oct-block-end-line () - "Returns t if line contains end of Octave block." - (save-excursion - (beginning-of-line) - (looking-at (concat "\\([^%#\n]*[ \t]\\)?" oct-block-end-kw)))) - -(defconst oct-block-end-kw "\\(end\\|endfor\\|endwhile\\|endif\\|endfunction\\|else\\|elseif\\)" - "Regular expression for keywords which end blocks.") - -(defun oct-block-beg-end-line () - "Returns t if line contains matching block begin-end in Octave-mode." - (save-excursion - (beginning-of-line) - (looking-at (concat - "\\([^%#\n]*[ \t]\\)?" oct-block-beg-kw - "." "\\([^%#\n]*[ \t]\\)?" oct-block-end-kw)))) - -(defun oct-unbal-matexp-line () - (if (= (oct-calc-matexp-indent) 0) - () - t)) - -(defun oct-calc-matexp-indent () - (let ((indent 0)) - (save-excursion - (beginning-of-line) - (while (< (point) (oct-eoln-point)) - (cond - ((looking-at "\\[") - (setq indent (+ indent octave-indent-level))) - ((looking-at "\\]") - (setq indent (- indent octave-indent-level)))) - (forward-char))) - (* 2 indent))) - -(defun oct-comment-on-line () - "Returns t if current line contains a comment." - (save-excursion - (beginning-of-line) - (looking-at "[^\n]*[%#]"))) - -(defun oct-in-comment () - "Returns t if point is in a comment." - (save-excursion - (and (/= (point) (point-max)) (forward-char)) - (search-backward "[%#]" (save-excursion (beginning-of-line) (point)) t))) - -(provide 'octave-mode) - -;; --- last line of octave-mode.el ---
deleted file mode 100644 --- a/src/DLList-fi.cc +++ /dev/null @@ -1,40 +0,0 @@ -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -// Instantiate Lists of various values. - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <DLList.h> - -#include "file-info.h" - -template class DLNode <file_info>; -template class DLList <file_info>; - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/Map-i.cc +++ /dev/null @@ -1,43 +0,0 @@ -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -// Instantiate Maps of octave_values. - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "Map.h" -#include "Map.cc" - -template class Map<int>; -template class CHNode<int>; -template class CHMap<int>; - -template static int goodCHptr (CHNode<int> *t); -template static int CHptr_to_index (CHNode<int> *t); - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/Queue.h +++ /dev/null @@ -1,53 +0,0 @@ -// This may look like C code, but it is really -*- C++ -*- -/* -Copyright (C) 1988 Free Software Foundation - written by Doug Lea (dl@rocky.oswego.edu) - -This file is part of the GNU C++ Library. This library is free -software; you can redistribute it and/or modify it under the terms of -the GNU Library General Public License as published by the Free -Software Foundation; either version 2 of the License, or (at your -option) any later version. This library 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 Library General Public License for more details. -You should have received a copy of the GNU Library General Public -License along with this library; if not, write to the Free Software -Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -*/ - - -#ifndef _Queue_h -#define _Queue_h 1 - -template <class T> -class -Queue -{ -public: - Queue (void) { } - - virtual ~Queue (void) { } - - virtual void enq (const T& item) = 0; - - virtual T deq (void) = 0; - - virtual T& front (void) = 0; - - virtual void del_front (void) = 0; - - virtual void clear (void) = 0; - - virtual int empty (void) const = 0; - - virtual int full (void) const = 0; - - virtual int length (void) const = 0; - - void error (const char*); - - virtual int OK (void) = 0; -}; - -#endif
deleted file mode 100644 --- a/src/SLList-str.cc +++ /dev/null @@ -1,41 +0,0 @@ -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -// Instantiate Lists of strings. - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "SLList.h" -#include "SLList.cc" - -#include <string> - -template class SLNode<string>; -template class SLList<string>; - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/SLQueue.h +++ /dev/null @@ -1,68 +0,0 @@ -// This may look like C code, but it is really -*- C++ -*- -/* -Copyright (C) 1988 Free Software Foundation - written by Doug Lea (dl@rocky.oswego.edu) - -This file is part of the GNU C++ Library. This library is free -software; you can redistribute it and/or modify it under the terms of -the GNU Library General Public License as published by the Free -Software Foundation; either version 2 of the License, or (at your -option) any later version. This library 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 Library General Public License for more details. -You should have received a copy of the GNU Library General Public -License along with this library; if not, write to the Free Software -Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -*/ - - -#if !defined (_SLQueue_h) -#define _SLQueue_h 1 - -#include "SLList.h" -#include "Queue.h" - -template <class T> -class -SLQueue : public Queue<T> -{ - private: - SLList<T> p; - - public: - SLQueue (void) : p () { } - - SLQueue (const SLQueue<T>& q) : p (q.p) { } - - ~SLQueue (void) { } - - void operator = (const SLQueue<T>& s) { p = s.p; } - - void enq (const T& item) { p.append (item); } - - T deq (void) { return p.remove_front (); } - - T& front (void) { return p.front (); } - - void del_front (void) { p.del_front (); } - - void clear (void) { p.clear (); } - - int empty (void) const { return p.empty (); } - - int full (void) const { return 0; } - - int length (void) const { return p.length (); } - - int OK (void) { return p.OK (); } -}; - -#endif - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/bogus.cc +++ /dev/null @@ -1,54 +0,0 @@ -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include "defun-dld.h" -#include "error.h" -#include "f77-fcn.h" -#include "oct-obj.h" -#include "procstream.h" - -#undef F77_XFCN_ERROR -#if defined (F77_UPPERCASE_NAMES) -#define F77_XFCN_ERROR(f, F) \ - (*current_liboctave_error_handler) \ - ("exception encountered in Fortran subroutine %s", #F) -#else -#define F77_XFCN_ERROR(f, F) \ - (*current_liboctave_error_handler) \ - ("exception encountered in Fortran subroutine %s", #f) -#endif - -extern "C" -{ - int F77_FCN (dgemv, DGEMV) (const char*, const int&, const int&, - const double&, const double*, - const int&, const double*, const int&, - const double&, double*, const int&, - long); -} - -DEFUN_DLD_BUILTIN (bogus, , , - "bogus (): bogus function") -{ - octave_value_list retval; - - double *x; - F77_XFCN (dgemv, DGEMV, ("x", 1, 2, 1.0, x, 5, x, 7, 8.0, x, 10, 1L)); - - if (error_state) - error ("error in bogus"); - - iostream *s = new procstream (); - s.tellg (); - s.seekg (0, ios::beg); - - return retval; -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/file-info.cc +++ /dev/null @@ -1,103 +0,0 @@ -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -// Originally written by John C. Campbell <jcc@bevo.che.wisc.edu> - -// Completely rewritten by John W. Eaton <jwe@bevo.che.wisc.edu>, -// April 1996. - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <cstdio> - -#include "file-info.h" - -file_info::file_info (void) -{ - file_number = -1; - file_fptr = 0; -} - -file_info::file_info (int n, const string& nm, FILE *t, const string& md) -{ - file_number = n; - file_name = nm; - file_fptr = t; - file_mode = md; -} - -file_info::file_info (const file_info& f) -{ - file_number = f.file_number; - file_name = f.file_name; - file_fptr = f.file_fptr; - file_mode = f.file_mode; -} - -file_info& -file_info::operator = (const file_info& f) -{ - if (this != & f) - { - file_number = f.file_number; - file_name = f.file_name; - file_fptr = f.file_fptr; - file_mode = f.file_mode; - } - return *this; -} - -file_info::~file_info (void) -{ -} - -int -file_info::number (void) const -{ - return file_number; -} - -string -file_info::name (void) const -{ - return file_name; -} - -FILE * -file_info::fptr (void) const -{ - return file_fptr; -} - -string -file_info::mode (void) const -{ - return file_mode; -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/file-info.h +++ /dev/null @@ -1,67 +0,0 @@ -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -// Written by John C. Campbell <jcc@bevo.che.wisc.edu> - -#if !defined (octave_file_info_h) -#define octave_file_info_h 1 - -#include <cstdio> - -#include <string> - -#include <Pix.h> - -class -file_info -{ -public: - file_info (void); - file_info (int num, const string& nm, FILE *t, const string& md); - file_info (const file_info& f); - - file_info& operator = (const file_info& f); - - ~file_info (void); - - int number (void) const; - string name (void) const; - FILE *fptr (void) const; - string mode (void) const; - - int eof (void) const; - int error (void) const; - -private: - int file_number; - string file_name; - FILE *file_fptr; - string file_mode; -}; - -#endif - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
deleted file mode 100755 --- a/src/move-if-change +++ /dev/null @@ -1,15 +0,0 @@ -#!/bin/sh -# -# Like mv $1 $2, but if the files are the same, just delete $1. -# Status is 0 if $2 is changed, 1 otherwise. - -if test -r $2; then - if cmp $1 $2 > /dev/null; then - echo $2 is unchanged - rm -f $1 - else - mv -f $1 $2 - fi -else - mv -f $1 $2 -fi
deleted file mode 100644 --- a/src/oct-tilde.h +++ /dev/null @@ -1,38 +0,0 @@ -// oct-tilde.h -*- C++ -*- -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if !defined (octave_octave_tilde_h) -#define octave_octave_tilde_h 1 - -#include <string> - -extern string oct_tilde_expand (const string&); - -#endif - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/terminals.h +++ /dev/null @@ -1,40 +0,0 @@ -// Available graphics terminals. -*- C++ -*- -/* - -Copyright (C) 1992, 1993 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -*/ - -#if !defined (_terminals_h) -#define _terminals_h 1 - -#ifdef __GNUG__ -#pragma interface -#endif - -extern int valid_terminal (char *); - -#endif - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/tree.h.old +++ /dev/null @@ -1,789 +0,0 @@ -// Tree classes. -*- C++ -*- -/* - -Copyright (C) 1992, 1993, 1994 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -*/ - -#if !defined (octave_tree_h) -#define octave_tree_h 1 - -#if defined (__GNUG__) -#pragma interface -#endif - -#include <stdio.h> - -class ostrstream; - -#include "builtins.h" -#include "tree-base.h" -#include "tree-const.h" - -class symbol_record; -class symbol_table; - -#ifndef TREE_FCN_TYPEDEFS -#define TREE_FCN_TYPEDEFS 1 - -typedef tree_constant (*Text_fcn)(int, char **); -typedef tree_constant* (*General_fcn)(const tree_constant *, int, int); - -#endif - -#ifndef NULL_TREE -#define NULL_TREE (tree *) NULL -#endif - -#ifndef NULL_TREE_CONST -#define NULL_TREE_CONST (tree_constant *) NULL -#endif - -/* - * Forward declarations. - */ -class tree; -class tree_constant_rep; -class tree_constant; -class tree_matrix; -class tree_builtin; -class tree_identifier; -class tree_function; -class tree_expression; -class tree_prefix_expression; -class tree_postfix_expression; -class tree_unary_expression; -class tree_binary_expression; -class tree_assignment_expression; -class tree_simple_assignment_expression; -class tree_multi_assignment_expression; -class tree_colon_expression; -class tree_index_expression; -class tree_argument_list; -class tree_parameter_list; -class tree_return_list; -class tree_command; -class tree_command_list; -class tree_global_command; -class tree_while_command; -class tree_for_command; -class tree_if_command; -class tree_break_command; -class tree_continue_command; -class tree_return_command; -class tree_plot_limits; -class tree_plot_range; -class tree_subplot; -class tree_subplot_using; -class tree_subplot_style; -class tree_subplot_list; -class tree_plot_command; - -/* - * General matrices. This allows us to construct matrices from - * other matrices, variables, and functions. - */ -class -tree_matrix : public tree -{ -public: - tree_matrix (void); - tree_matrix (tree *t, tree::matrix_dir d); - - ~tree_matrix (void); - - tree_matrix *chain (tree *t, tree::matrix_dir d); - tree_matrix *reverse (void); - int length (void); - - tree_return_list *to_return_list (void); - - tree_constant eval (int print); - -private: - tree::matrix_dir dir; // Direction to the next element. - tree *element; - tree_matrix *next; -}; - -/* - * Builtin functions. - */ -class -tree_builtin : public tree -{ -public: - tree_builtin (const char *nm = (char *) NULL); - - tree_builtin (int i_max, int o_max, Mapper_fcn& m_fcn, - const char *nm = (char *) NULL); - - tree_builtin (int i_max, int o_max, Text_fcn t_fcn, - const char *nm = (char *) NULL); - - tree_builtin (int i_max, int o_max, General_fcn t_fcn, - const char *nm = (char *) NULL); - - ~tree_builtin (void); - - int is_builtin (void) const; - - tree_constant eval (int print); - - tree_constant *eval (int print, int nargout); - - tree_constant *eval (const tree_constant *args, int nargin, - int nargout, int print); - - char *name (void) const; - - int max_expected_args (void); - -private: - int nargin_max; - int nargout_max; - Mapper_fcn mapper_fcn; - Text_fcn text_fcn; - General_fcn general_fcn; - char *my_name; -}; - -/* - * Symbols from the symbol table. - */ -class -tree_identifier : public tree -{ - friend class tree_index_expression; - -public: - tree_identifier (int l = -1, int c = -1); - tree_identifier (symbol_record *s, int l = -1, int c = -1); - - ~tree_identifier (void); - - int is_identifier (void) const; - - char *name (void) const; - void rename (const char *n); - - tree_identifier *define (tree_constant *t); - tree_identifier *define (tree_function *t); - - void document (char *s); - - tree_constant assign (tree_constant& t); - tree_constant assign (tree_constant& t, tree_constant *args, int nargs); - - void bump_value (tree::expression_type); - - int parse_fcn_file (int exec_script = 1); - int parse_fcn_file (char *ff, int exec_script = 1); - void parse_fcn_file (FILE *ffile, char *ff); - - tree *do_lookup (int& script_file_executed); - - void mark_as_formal_parameter (void); - - void mark_for_possible_ans_assign (void); - - tree_constant eval (int print); - - tree_constant *eval (int print, int nargout); - - tree_constant *eval (const tree_constant *args, int nargin, - int nargout, int print); - - void eval_undefined_error (void); - -private: - symbol_record *sym; - int maybe_do_ans_assign; -}; - -/* - * User defined functions. - */ -class -tree_function : public tree -{ -public: - tree_function (void); - tree_function (tree *cl, symbol_table *st); - - ~tree_function (void); - - tree_function *define (tree *t); - tree_function *define_param_list (tree_parameter_list *t); - tree_function *define_ret_list (tree_parameter_list *t); - - void stash_fcn_file_name (char * s); - void stash_fcn_file_time (time_t t); - - char *fcn_file_name (void); - time_t time_parsed (void); - - void mark_as_system_fcn_file (void); - int is_system_fcn_file (void) const; - - int takes_varargs (void) const; - void octave_va_start (void); - tree_constant octave_va_arg (void); - - void stash_function_name (char *s); - char *function_name (void); - - tree_constant eval (int print); - - tree_constant *eval (int print, int nargout); - - tree_constant *eval (const tree_constant *args, int nargin, - int nargout, int print); - - int max_expected_args (void); - - void traceback_error (void); - -private: - int call_depth; - tree_parameter_list *param_list; - tree_parameter_list *ret_list; - symbol_table *sym_tab; - tree *cmd_list; - char *file_name; - char *fcn_name; - time_t t_parsed; - int system_fcn_file; - int varargs_ok; - int num_named_args; - const tree_constant *args_passed; - int num_args_passed; - int curr_arg_number; -}; - -/* - * A base class for expressions. - */ -class -tree_expression : public tree -{ -public: - tree_expression (void); - - ~tree_expression (void); - - tree_constant eval (int print); - -protected: - expression_type etype; -}; - -/* - * Prefix expressions. - */ -class -tree_prefix_expression : public tree_expression -{ - public: - tree_prefix_expression (int l = -1, int c = -1); - tree_prefix_expression (tree_identifier *t, tree::expression_type et, - int l = -1, int c = -1); - - ~tree_prefix_expression (void); - - tree_constant eval (int print); - - void eval_error (void); - - int is_prefix_expression (void) const; - - private: - tree_identifier *id; -}; - -/* - * Postfix expressions. - */ -class -tree_postfix_expression : public tree_expression -{ - public: - tree_postfix_expression (int l = -1, int c = -1); - tree_postfix_expression (tree_identifier *t, tree::expression_type et, - int l = -1, int c = -1); - - ~tree_postfix_expression (void); - - tree_constant eval (int print); - - void eval_error (void); - - private: - tree_identifier *id; -}; - -/* - * Unary expressions. - */ -class -tree_unary_expression : public tree_expression -{ - public: - tree_unary_expression (int l = -1, int c = -1); - tree_unary_expression (tree *a, tree::expression_type t, int l = -1, - int c = -1); - - ~tree_unary_expression (void); - - tree_constant eval (int print); - - void eval_error (void); - - private: - tree *op; -}; - -/* - * Binary expressions. - */ -class -tree_binary_expression : public tree_expression -{ - public: - tree_binary_expression (int l = -1, int c = -1); - tree_binary_expression (tree *a, tree *b, tree::expression_type t, - int l = -1, int c = -1); - - ~tree_binary_expression (void); - - tree_constant eval (int print); - - void eval_error (void); - - private: - tree *op1; - tree *op2; -}; - -/* - * Assignment expressions. - */ -class -tree_assignment_expression : public tree_expression -{ -public: - int in_parens; - - tree_assignment_expression (void); - - ~tree_assignment_expression (void); - - tree_constant eval (int print); - - int is_assignment_expression (void) const; -}; - -/* - * Simple assignment expressions. - */ -class -tree_simple_assignment_expression : public tree_assignment_expression -{ - public: - tree_simple_assignment_expression (int l = -1, int c = -1); - tree_simple_assignment_expression (tree_identifier *i, tree *r, - int l = -1, int c = -1); - tree_simple_assignment_expression (tree_index_expression *idx_expr, - tree *r, int l = -1, int c = -1); - - ~tree_simple_assignment_expression (void); - - tree_constant eval (int print); - - void eval_error (void); - - private: - tree_identifier *lhs; - tree_argument_list *index; - tree *rhs; -}; - -/* - * Multi-valued assignment expressions. - */ -class -tree_multi_assignment_expression : public tree_assignment_expression -{ - public: - tree_multi_assignment_expression (int l = -1, int c = -1); - tree_multi_assignment_expression (tree_return_list *lst, tree *r, - int l = -1, int c = -1); - - ~tree_multi_assignment_expression (void); - - tree_constant eval (int print); - - tree_constant *eval (int print, int nargout); - - void eval_error (void); - - private: - tree_return_list *lhs; - tree *rhs; -}; - -/* - * Colon expressions. - */ -class -tree_colon_expression : public tree_expression -{ - public: - tree_colon_expression (int l = -1, int c = -1); - tree_colon_expression (tree *a, tree *b, int l = -1, int c = -1); - - ~tree_colon_expression (void); - - tree_colon_expression *chain (tree *t); - - tree_constant eval (int print); - - void eval_error (const char *s); - - private: - tree *op1; - tree *op2; - tree *op3; -}; - -/* - * Index expressions. - */ -class -tree_index_expression : public tree_expression -{ - public: - tree_index_expression (int l = -1, int c = -1); - tree_index_expression (tree_identifier *i, int l = -1, int c = -1); - tree_index_expression (tree_identifier *i, tree_argument_list *lst, - int l = -1, int c = -1); - - ~tree_index_expression (void); - - int is_index_expression (void) const; - - tree_identifier *ident (void); - - tree_argument_list *arg_list (void); - - void mark_for_possible_ans_assign (void); - - tree_constant eval (int print); - - tree_constant *eval (int print, int nargout); - - void eval_error (void); - - private: - tree_identifier *id; - tree_argument_list *list; -}; - -/* - * Argument lists. - */ -class -tree_argument_list : public tree -{ - public: - tree_argument_list (void); - tree_argument_list (tree *t); - - ~tree_argument_list (void); - - tree_argument_list *chain (tree *t); - tree_argument_list *reverse (void); - int length (void); - - tree_argument_list *next_elem (void); - - tree_constant *convert_to_const_vector (int& nargs); - - tree_constant eval (int print); - - private: - tree *arg; - tree_argument_list *next; -}; - -/* - * Parameter lists. Almost like argument lists, except that the - * elements are only supposed to be identifiers, never constants or - * expressions. - */ -class -tree_parameter_list : public tree -{ - public: - tree_parameter_list (void); - tree_parameter_list (tree_identifier *t); - - ~tree_parameter_list (void); - - tree_parameter_list *chain (tree_identifier *t); - tree_parameter_list *reverse (void); - int length (void); - - char *name (void) const; - - void mark_as_formal_parameters (void); - - void mark_varargs (void); - int takes_varargs (void) const; - - tree_identifier *define (tree_constant *t); - - void define_from_arg_vector (const tree_constant *args, int nargin); - - tree_constant *convert_to_const_vector (void); - - tree_parameter_list *next_elem (void); - - tree_constant eval (int print); - - private: - int marked_for_varargs; - tree_identifier *param; - tree_parameter_list *next; -}; - -/* - * Return lists. Almost like parameter lists, except that the - * elements may also be index expressions. - */ -class -tree_return_list : public tree -{ - public: - tree_return_list (void); - tree_return_list (tree_identifier *t); - tree_return_list (tree_index_expression *t); - - ~tree_return_list (void); - - tree_return_list *chain (tree_identifier *t); - tree_return_list *chain (tree_index_expression *t); - tree_return_list *reverse (void); - int length (void); - - tree_index_expression *idx_expr (void); - - tree_return_list *next_elem (void); - - tree_constant eval (int print); - - private: - tree_index_expression *retval; - tree_return_list *next; -}; - -/* - * A base class for commands. - */ -class -tree_command : public tree -{ -}; - -/* - * A command or two to be executed. - */ -class -tree_command_list : public tree_command -{ - public: - tree_command_list (void); - tree_command_list (tree *t); - - ~tree_command_list (void); - - tree_command_list *chain (tree *t); - tree_command_list *reverse (void); - - void set_print_flag (int print); - - tree_constant eval (int print); - - private: - tree *command; // Command to execute. - int print_flag; // Print result of eval for this command? - tree_command_list *next; // Next command in list. -}; - -/* - * Global. - */ -class -tree_global_command : public tree_command -{ - public: - tree_global_command (int l = -1, int c = -1); - tree_global_command (symbol_record *s, int l = -1, int c = -1); - tree_global_command (symbol_record *s, tree *e, int l = -1, int c = -1); - - ~tree_global_command (void); - - tree_global_command *chain (symbol_record *s, int l = -1, int c = -1); - tree_global_command *chain (symbol_record *s, tree *e, int l = -1, int c = -1); - tree_global_command *reverse (void); - - tree_constant eval (int print); - - void eval_error (void); - - private: - symbol_record *sr; // Symbol record from local symbol table. - tree *rhs; // RHS of assignment. - tree_global_command *next; // Next global command. -}; - -/* - * While. - */ -class -tree_while_command : public tree_command -{ - public: - tree_while_command (int l = -1, int c = -1); - tree_while_command (tree *e, int l = -1, int c = -1); - tree_while_command (tree *e, tree *lst, int l = -1, int c = -1); - - ~tree_while_command (void); - - tree_constant eval (int print); - - void eval_error (void); - - private: - tree *expr; // Expression to test. - tree *list; // List of commands to execute. -}; - -/* - * For. - */ -class -tree_for_command : public tree_command -{ - public: - tree_for_command (int l = -1, int c = -1); - tree_for_command (tree_index_expression *id, tree *e, tree *lst, - int l = -1, int c = -1); - - ~tree_for_command (void); - - tree_constant eval (int print); - - void eval_error (void); - - private: - tree_constant do_for_loop_once (tree_constant *rhs, int& quit); - - tree_index_expression *id; // Identifier to modify. - tree *expr; // Expression to evaluate. - tree *list; // List of commands to execute. -}; - -/* - * Simple if. - */ -class -tree_if_command : public tree_command -{ - public: - tree_if_command (int l = -1, int c = -1); - tree_if_command (tree *t, int l = -1, int c = -1); - tree_if_command (tree *e, tree *t, int l = -1, int c = -1); - - ~tree_if_command (void); - - tree_if_command *chain (tree *t, int l = -1, int c = -1); - tree_if_command *chain (tree *t1, tree *t2, int l = -1, int c = -1); - tree_if_command *reverse (void); - - tree_constant eval (int print); - - void eval_error (void); - - private: - tree *expr; // Expression to test. - tree *list; // Commands to execute. - tree_if_command *next; // Next if command. -}; - -/* - * Break. - */ -class -tree_break_command : public tree_command -{ - public: - tree_break_command (int l = -1, int c = -1); - - ~tree_break_command (void); - - tree_constant eval (int print); -}; - -/* - * Continue. - */ -class -tree_continue_command : public tree_command -{ - public: - tree_continue_command (int l = -1, int c = -1); - - ~tree_continue_command (void); - - tree_constant eval (int print); -}; - -/* - * Return. - */ -class -tree_return_command : public tree_command -{ - public: - tree_return_command (int l = -1, int c = -1); - - ~tree_return_command (void); - - tree_constant eval (int print); -}; - -#endif - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; page-delimiter: "^/\\*" *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/user-prefs.cc +++ /dev/null @@ -1,501 +0,0 @@ -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#include <cstdio> -#include <cstdlib> -#include <cstring> - -#include "error.h" -#include "gripes.h" -#include "mappers.h" -#include "oct-hist.h" -#include "sysdep.h" -#include "user-prefs.h" -#include "utils.h" -#include "variables.h" - -// The list of user preferences. Values change when global variables -// change, so we don't have to do a variable look up every time we -// need to check a preference. -user_preferences user_pref; - -// Initialize global user_pref structure. - -void -init_user_prefs (void) -{ - user_pref.history_size = 0; - user_pref.ignore_function_time_stamp = 0; - user_pref.print_answer_id_name = 0; - user_pref.read_only_constants = 1; - user_pref.save_precision = 0; - user_pref.saving_history = 0; - user_pref.suppress_verbose_help_message = 0; - user_pref.treat_neg_dim_as_zero = 0; - user_pref.warn_divide_by_zero = 0; - - user_pref.default_save_format = string (); - user_pref.editor = string (); - user_pref.exec_path = string (); - user_pref.history_file = string (); - user_pref.imagepath = string (); - user_pref.info_file = string (); - user_pref.info_prog = string (); - user_pref.loadpath = string (); - user_pref.pwd = string (); -} - -// Check the value of a string variable to see if it it's ok to do -// something. -// -// return of 1 => always ok. -// return of 0 => never ok. -// return of -1 => ok, but give me warning (default). - -int -check_preference (const string& var) -{ - int pref = -1; - - string val = builtin_string_variable (var); - - if (val.empty ()) - { - double dval = 0; - if (builtin_real_scalar_variable (var, dval)) - pref = NINT (dval); - } - else - { - if (val.compare ("yes", 0, 3) == 0 - || val.compare ("true", 0, 4) == 0) - pref = 1; - else if (val.compare ("never", 0, 5) == 0 - || val.compare ("no", 0, 2) == 0 - || val.compare ("false", 0, 5) == 0) - pref = 0; - } - - return pref; -} - -// XXX FIXME XXX -- some of these should do their own checking to be -// able to provide more meaningful warning or error messages. - -// Echo commands as they are executed? -// -// 1 ==> echo commands read from script files -// 2 ==> echo commands from functions -// 4 ==> echo commands read from command line -// -// more than one state can be active at once. - -int -echo_executing_commands (void) -{ - user_pref.echo_executing_commands - = check_preference ("echo_executing_commands"); - - return 0; -} - - -// How many lines of command history should we save? - -int -history_size (void) -{ - double val; - if (builtin_real_scalar_variable ("history_size", val) - && ! xisnan (val)) - { - int ival = NINT (val); - if (ival >= 0 && (double) ival == val) - { - user_pref.history_size = ival; - octave_command_history.set_size (ival); - return 0; - } - } - gripe_invalid_value_specified ("history_size"); - return -1; -} - - -// Should Octave always check to see if function files have changed -// since they were last compiled? - -int -ignore_function_time_stamp (void) -{ - int pref = 0; - - string val = builtin_string_variable ("ignore_function_time_stamp"); - - if (! val.empty ()) - { - if (val.compare ("all", 0, 3) == 0) - pref = 2; - if (val.compare ("system", 0, 6) == 0) - pref = 1; - } - - user_pref.ignore_function_time_stamp = pref; - - return 0; -} - - -// Should we print things like -// -// octave> a = [1,2;3,4] -// a = -// -// 1 2 -// 3 4 - -int -print_answer_id_name (void) -{ - user_pref.print_answer_id_name = check_preference ("print_answer_id_name"); - - return 0; -} - - -// Should built-in constants always be read only? - -int -read_only_constants (void) -{ - user_pref.read_only_constants = check_preference ("read_only_constants"); - - return 0; -} - - -// Should we save command history? - -int -saving_history (void) -{ - user_pref.saving_history = check_preference ("saving_history"); - octave_command_history.ignore_entries (! user_pref.saving_history); - return 0; -} - - -// Suppress printing of additional help message in help and usage -// functions? - -int -suppress_verbose_help_message (void) -{ - user_pref.suppress_verbose_help_message = - check_preference ("suppress_verbose_help_message"); - - return 0; -} - - -// Should things like: -// -// octave> ones (-1, 5) -// -// result in an empty matrix or an error? - -int -treat_neg_dim_as_zero (void) -{ - user_pref.treat_neg_dim_as_zero - = check_preference ("treat_neg_dim_as_zero"); - - return 0; -} - - -// On IEEE machines, allow divide by zero errors to be suppressed. - -int -warn_divide_by_zero (void) -{ - user_pref.warn_divide_by_zero = check_preference ("warn_divide_by_zero"); - - return 0; -} - -int -set_save_precision (void) -{ - double val; - if (builtin_real_scalar_variable ("save_precision", val) - && ! xisnan (val)) - { - int ival = NINT (val); - if (ival >= 0 && (double) ival == val) - { - user_pref.save_precision = ival; - return 0; - } - } - gripe_invalid_value_specified ("save_precision"); - return -1; -} - -int -sv_default_save_format (void) -{ - int status = 0; - - string s = builtin_string_variable ("default_save_format"); - - if (s.empty ()) - { - gripe_invalid_value_specified ("default_save_format"); - status = -1; - } - else - user_pref.default_save_format = s; - - return status; -} - -int -sv_editor (void) -{ - int status = 0; - - string s = builtin_string_variable ("EDITOR"); - - if (s.empty ()) - { - gripe_invalid_value_specified ("EDITOR"); - status = -1; - } - else - user_pref.editor = s; - - return status; -} - -int -sv_exec_path (void) -{ - int status = 0; - - string exec_path = builtin_string_variable ("EXEC_PATH"); - - if (exec_path.empty ()) - { - gripe_invalid_value_specified ("EXEC_PATH"); - status = -1; - } - else - { - string arch_dir = octave_arch_lib_dir (); - string bin_dir = octave_bin_dir (); - - int len = arch_dir.length () + bin_dir.length () + strlen (SEPCHAR_STR); - - static char *putenv_cmd = 0; - - delete [] putenv_cmd; - - putenv_cmd = 0; - - int eplen = exec_path.length (); - - if (eplen > 0) - { - int prepend = (exec_path[0] == ':'); - int append = (eplen > 1 && exec_path[eplen-1] == ':'); - - if (prepend) - { - if (append) - { - putenv_cmd = new char [2 * len + eplen + 6]; - sprintf (putenv_cmd, - "PATH=%s" SEPCHAR_STR "%s%s%s" SEPCHAR_STR "%s", - arch_dir.c_str (), bin_dir.c_str (), - exec_path.c_str (), arch_dir.c_str (), - bin_dir.c_str ()); - } - else - { - putenv_cmd = new char [len + eplen + 6]; - sprintf (putenv_cmd, - "PATH=%s" SEPCHAR_STR "%s%s", - arch_dir.c_str (), bin_dir.c_str (), - exec_path.c_str ()); - } - } - else - { - if (append) - { - putenv_cmd = new char [len + eplen + 6]; - sprintf (putenv_cmd, - "PATH=%s%s" SEPCHAR_STR "%s", - exec_path.c_str (), arch_dir.c_str (), - bin_dir.c_str ()); - } - else - { - putenv_cmd = new char [len + eplen + 6]; - sprintf (putenv_cmd, "PATH=%s", exec_path.c_str ()); - } - } - } - else - { - putenv_cmd = new char [len+6]; - sprintf (putenv_cmd, "PATH=%s" SEPCHAR_STR "%s", - arch_dir.c_str (), bin_dir.c_str ()); - } - - putenv (putenv_cmd); - } - - return status; -} - -int -sv_history_file (void) -{ - int status = 0; - - string s = builtin_string_variable ("history_file"); - - if (s.empty ()) - { - gripe_invalid_value_specified ("history_file"); - status = -1; - } - else - { - user_pref.history_file = s; - octave_command_history.set_file (oct_tilde_expand (s)); - } - - return status; -} - -int -sv_imagepath (void) -{ - int status = 0; - - string s = builtin_string_variable ("IMAGEPATH"); - - if (s.empty ()) - { - gripe_invalid_value_specified ("IMAGEPATH"); - status = -1; - } - else - user_pref.imagepath = s; - - return status; -} - -int -sv_info_file (void) -{ - int status = 0; - - string s = builtin_string_variable ("INFO_FILE"); - - if (s.empty ()) - { - gripe_invalid_value_specified ("INFO_FILE"); - status = -1; - } - else - user_pref.info_file = s; - - return status; -} - -int -sv_info_prog (void) -{ - int status = 0; - - string s = builtin_string_variable ("INFO_PROGRAM"); - - if (s.empty ()) - { - gripe_invalid_value_specified ("INFO_PROGRAM"); - status = -1; - } - else - user_pref.info_prog = s; - - return status; -} - -int -sv_loadpath (void) -{ - int status = 0; - - string s = builtin_string_variable ("LOADPATH"); - - if (s.empty ()) - { - gripe_invalid_value_specified ("LOADPATH"); - status = -1; - } - else - user_pref.loadpath = maybe_add_default_load_path (s); - - return status; -} - -int -sv_pwd (void) -{ - int status = 0; - - string s = builtin_string_variable ("PWD"); - - if (s.empty ()) - { - gripe_invalid_value_specified ("PWD"); - status = -1; - } - else - user_pref.pwd = s; - - return status; -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/user-prefs.h +++ /dev/null @@ -1,94 +0,0 @@ -/* - -Copyright (C) 1996 John W. Eaton - -This file is part of Octave. - -Octave 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, or (at your option) any -later version. - -Octave 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 Octave; see the file COPYING. If not, write to the Free -Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -*/ - -#if !defined (octave_user_prefs_h) -#define octave_user_prefs_h 1 - -#include <string> - -struct user_preferences -{ - int echo_executing_commands; - int history_size; - int ignore_function_time_stamp; - int print_answer_id_name; - int read_only_constants; - int save_precision; - int saving_history; - int suppress_verbose_help_message; - int treat_neg_dim_as_zero; - int warn_divide_by_zero; - - string default_save_format; - string editor; - string exec_path; - string history_file; - string imagepath; - string info_file; - string info_prog; - string loadpath; - string pwd; -}; - -extern user_preferences user_pref; - -extern void init_user_prefs (void); - -extern int echo_executing_commands (void); -extern int history_size (void); -extern int ignore_function_time_stamp (void); -extern int print_answer_id_name (void); -extern int read_only_constants (void); -extern int saving_history (void); -extern int suppress_verbose_help_message (void); -extern int treat_neg_dim_as_zero (void); -extern int warn_divide_by_zero (void); - -extern int set_save_precision (void); - -extern int sv_default_save_format (void); -extern int sv_editor (void); -extern int sv_exec_path (void); -extern int sv_history_file (void); -extern int sv_imagepath (void); -extern int sv_info_file (void); -extern int sv_info_prog (void); -extern int sv_loadpath (void); -extern int sv_pwd (void); - -enum echo_state -{ - ECHO_OFF = 0, - ECHO_SCRIPTS = 1, - ECHO_FUNCTIONS = 2, - ECHO_CMD_LINE = 4 -}; - -extern int check_preference (const string& var); - -#endif - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/