Mercurial > hg > octave-max
changeset 3180:c17387059fd3
[project @ 1998-09-24 18:59:11 by jwe]
line wrap: on
line diff
--- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +Thu Sep 24 13:51:03 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * configure.in (AC_OUTPUT): Add libcruft/ordered-qz to the list. + +Mon Aug 31 12:07:02 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * config.sub: Accept armv4 everywhere arm is allowed. + +Tue Aug 18 17:02:25 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * mkoctfile.in: Allow -DDEF on command line. + Thu Jun 18 20:24:40 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> * configure.in (RLD_FLAG): Set correctly for Linux on all
--- a/NEWS +++ b/NEWS @@ -1,6 +1,9 @@ Summary of changes for version 2.1.x: ------------------------------------ + * If fread is given a skip parameter, the skip is performed after + the read instead of before (for compatibility with Matlab). + * Running `make check' should work now before you run `make install', even if you build a copy of Octave that depends on shared versions of the Octave libraries.
--- a/config.sub +++ b/config.sub @@ -150,7 +150,7 @@ # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. tahoe | i860 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \ - | arme[lb] | pyramid | mn10200 | mn10300 \ + | armv4 | arme[lb] | pyramid | mn10200 | mn10300 \ | tron | a29k | 580 | i960 | h8300 | hppa | hppa1.0 | hppa1.1 \ | alpha | alphaev5 | alphaev56 | we32k | ns16k | clipper \ | i370 | sh | powerpc | powerpcle | 1750a | dsp16xx | pdp11 \ @@ -172,7 +172,8 @@ ;; # Recognize the basic CPU types with company name. vax-* | tahoe-* | i[3456]86-* | i860-* | m32r-* | m68k-* | m68000-* \ - | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \ + | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* \ + | armv4-* | c[123]* \ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \ | power-* | none-* | 580-* | cray2-* | h8300-* | i960-* \ | xmp-* | ymp-* | hppa-* | hppa1.0-* | hppa1.1-* \
--- a/configure.in +++ b/configure.in @@ -21,7 +21,7 @@ ### Software Foundation, 59 Temple Place - Suite 330, Boston, MA ### 02111-1307, USA. -AC_REVISION($Revision: 1.307 $) +AC_REVISION($Revision: 1.308 $) AC_PREREQ(2.9) AC_INIT(src/octave.cc) AC_CONFIG_HEADER(config.h) @@ -1143,9 +1143,10 @@ libcruft/fftpack/Makefile libcruft/lapack/Makefile libcruft/linpack/Makefile libcruft/minpack/Makefile libcruft/misc/Makefile libcruft/odepack/Makefile - libcruft/quadpack/Makefile libcruft/ranlib/Makefile - libcruft/specfun/Makefile libcruft/slatec-fn/Makefile - libcruft/slatec-err/Makefile libcruft/villad/Makefile) + libcruft/ordered-qz libcruft/quadpack/Makefile + libcruft/ranlib/Makefile libcruft/specfun/Makefile + libcruft/slatec-fn/Makefile libcruft/slatec-err/Makefile + libcruft/villad/Makefile) chmod 755 install-octave
--- a/doc/interpreter/basics.texi +++ b/doc/interpreter/basics.texi @@ -732,7 +732,7 @@ @end defvr @defvr {Built-in Variable} saving_history -If the value of @code{saving_history} is @code{"true"}, command entered +If the value of @code{saving_history} is nonzero, command entered on the command line are saved in the file specified by the variable @code{history_file}. @end defvr
--- a/doc/interpreter/poly.texi +++ b/doc/interpreter/poly.texi @@ -105,7 +105,7 @@ coefficients are given by vector @var{c}. @end deftypefn -@deftypefn {Function File} {} polyfit (@var{n}, @var{y}, @var{n}) +@deftypefn {Function File} {[@var{p}, @var{yf}] =} polyfit (@var{x}, @var{y}, @var{n}) Return the coefficients of a polynomial @var{p}(@var{x}) of degree @var{n} that minimizes @iftex @@ -121,9 +121,12 @@ to best fit the data in the least squares sense. @end deftypefn +If two output arguments are requested, the second contains the values of +the polynomial for each value of @var{x}. + @deftypefn {Function File} {} polyinteg (@var{c}) -Return the coefficients of the integral the polynomial whose coefficients -are represented by the vector @var{c}. +Return the coefficients of the integral of the polynomial whose +coefficients are represented by the vector @var{c}. The constant of integration is set to zero. @end deftypefn
--- a/doc/interpreter/stmt.texi +++ b/doc/interpreter/stmt.texi @@ -686,7 +686,7 @@ @group save_do_fortran_indexing = do_fortran_indexing; unwind_protect - do_fortran_indexing = "true"; + do_fortran_indexing = 1; elt = a (idx) unwind_protect_cleanup do_fortran_indexing = save_do_fortran_indexing;
--- a/kpathsea/ChangeLog +++ b/kpathsea/ChangeLog @@ -1,3 +1,7 @@ +Mon Aug 31 12:07:02 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * config.sub: Accept armv4 everywhere arm is allowed. + Thu May 14 12:20:47 1998 John W. Eaton <jwe@bevo.che.wisc.edu> * acklibtool.m4: For use with Octave, disable support for shared
--- a/kpathsea/config.sub +++ b/kpathsea/config.sub @@ -150,7 +150,7 @@ # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. tahoe | i860 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \ - | arme[lb] | pyramid | mn10200 | mn10300 \ + | armv4 | arme[lb] | pyramid | mn10200 | mn10300 \ | tron | a29k | 580 | i960 | h8300 | hppa | hppa1.0 | hppa1.1 \ | alpha | alphaev5 | alphaev56 | we32k | ns16k | clipper \ | i370 | sh | powerpc | powerpcle | 1750a | dsp16xx | pdp11 \ @@ -172,7 +172,8 @@ ;; # Recognize the basic CPU types with company name. vax-* | tahoe-* | i[34567]86-* | i860-* | m32r-* | m68k-* | m68000-* \ - | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \ + | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* \ + | armv4-* | c[123]* \ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \ | power-* | none-* | 580-* | cray2-* | h8300-* | i960-* \ | xmp-* | ymp-* | hppa-* | hppa1.0-* | hppa1.1-* \
--- a/libcruft/ChangeLog +++ b/libcruft/ChangeLog @@ -1,3 +1,12 @@ +Thu Sep 24 11:59:02 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * lapack/xdlamch.f: New file. + + * ordered-qz: New directory. + * Makefile.in (CRUFT_DIRS): Add it to the list. + + * lapack/dggbak.f, lapack/dtgevc.f, lapack/zggbal.f: New files. + Tue Jun 2 09:57:52 1998 John W. Eaton <jwe@bevo.che.wisc.edu> * specfun/rybesl.f (rybesl): Don't access by(2) unless nb .gt. 1.
--- a/libcruft/Makefile.in +++ b/libcruft/Makefile.in @@ -25,8 +25,8 @@ # configure.in and run autoconf). CRUFT_DIRS = balgen blas dassl eispack fftpack lapack linpack \ - minpack misc odepack quadpack ranlib slatec-err slatec-fn \ - specfun villad + minpack misc odepack ordered-qz quadpack ranlib slatec-err \ + slatec-fn specfun villad SUBDIRS = $(CRUFT_DIRS)
new file mode 100644 --- /dev/null +++ b/libcruft/lapack/xdlamch.f @@ -0,0 +1,6 @@ + subroutine xdlamch (cmach, retval) + character cmach + double precision retval, dlamch + retval = dlamch (cmach) + return + end
new file mode 100644 --- /dev/null +++ b/libcruft/ordered-qz/Makefile.in @@ -0,0 +1,19 @@ +# +# Makefile for octave's libcruft/ordered-qz directory +# +# John W. Eaton +# jwe@bevo.che.wisc.edu +# University of Wisconsin-Madison +# Department of Chemical Engineering + +TOPDIR = ../.. + +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +VPATH = @srcdir@ + +EXTERNAL_DISTFILES = $(DISTFILES) + +include $(TOPDIR)/Makeconf + +include ../Makerules
new file mode 100644 --- /dev/null +++ b/libcruft/ordered-qz/README @@ -0,0 +1,2 @@ +Code in this directory is adapted from Paul Van Dooren's toms/590 +code. Modifications are listed in the comment header sections.
new file mode 100644 --- /dev/null +++ b/libcruft/ordered-qz/dsubsp.f @@ -0,0 +1,104 @@ + SUBROUTINE DSUBSP(NMAX, N, A, B, Z, FTEST, EPS, NDIM, FAIL, IND) + INTEGER NMAX, N, FTEST, NDIM, IND(N) + LOGICAL FAIL + DOUBLE PRECISION A(NMAX,N), B(NMAX,N), Z(NMAX,N), EPS +C* +C* GIVEN THE UPPER TRIANGULAR MATRIX B AND UPPER HESSENBERG MATRIX A +C* WITH 1X1 OR 2X2 DIAGONAL BLOCKS, THIS ROUTINE REORDERS THE DIAGONAL +C* BLOCKS ALONG WITH THEIR GENERALIZED EIGENVALUES BY CONSTRUCTING EQUI- +C* VALENCE TRANSFORMATIONS QT AND ZT. THE ROW TRANSFORMATION ZT IS ALSO +C* PERFORMED ON THE GIVEN (INITIAL) TRANSFORMATION Z (RESULTING FROM A +C* POSSIBLE PREVIOUS STEP OR INITIALIZED WITH THE IDENTITY MATRIX). +C* AFTER REORDERING, THE EIGENVALUES INSIDE THE REGION SPECIFIED BY THE +C* FUNCTION FTEST APPEAR AT THE TOP. IF NDIM IS THEIR NUMBER THEN THE +C* NDIM FIRST COLUMNS OF Z SPAN THE REQUESTED SUBSPACE. DSUBSP REQUIRES +C* THE SUBROUTINE EXCHQZ AND THE INTEGER FUNCTION FTEST WHICH HAS TO BE +C* PROVIDED BY THE USER. THE PARAMETERS IN THE CALLING SEQUENCE ARE : +C* (STARRED PARAMETERS ARE ALTERED BY THE SUBROUTINE) +C* +C* NMAX THE FIRST DIMENSION OF A, B AND Z +C* N THE ORDER OF A, B AND Z +C* *A,*B THE MATRIX PAIR WHOSE BLOCKS ARE TO BE REORDERED. +C* *Z UPON RETURN THIS ARRAY IS MULTIPLIED BY THE COLUMN +C* TRANSFORMATION ZT. +C* FTEST(LS,ALPHA,BETA,S,P) AN INTEGER FUNCTION DESCRIBING THE +C* SPECTRUM OF THE DEFLATING SUBSPACE TO BE COMPUTED: +C* WHEN LS=1 FTEST CHECKS IF ALPHA/BETA IS IN THAT SPECTRUM +C* WHEN LS=2 FTEST CHECKS IF THE TWO COMPLEX CONJUGATE +C* ROOTS WITH SUM S AND PRODUCT P ARE IN THAT SPECTRUM +C* IF THE ANSWER IS POSITIVE, FTEST=1, OTHERWISE FTEST=-1 +C* EPS THE REQUIRED ABSOLUTE ACCURACY OF THE RESULT +C* *NDIM AN INTEGER GIVING THE DIMENSION OF THE COMPUTED +C* DEFLATING SUBSPACE +C* *FAIL A LOGICAL VARIABLE WHICH IS FALSE ON A NORMAL RETURN, +C* TRUE OTHERWISE (WHEN EXCHQZ FAILS) +C* *IND AN INTEGER WORKING ARRAY OF DIMENSION AT LEAST N +C* + INTEGER L, LS, LS1, LS2, L1, LL, NUM, IS, L2I, L2K, I, K, II, + * ISTEP, IFIRST, J + DOUBLE PRECISION S, P, D, ALPHA, BETA + FAIL = .TRUE. + NDIM = 0 + NUM = 0 + L = 0 + LS = 1 +C*** CONSTRUCT ARRAY IND(I) WHERE : +C*** IABS(IND(I)) IS THE SIZE OF THE BLOCK I +C*** SIGN(IND(I)) INDICATES THE LOCATION OF ITS EIGENVALUES +C*** (AS DETERMINED BY FTEST). +C*** NUM IS THE NUMBER OF ELEMENTS IN THIS ARRAY + DO 30 LL=1,N + L = L + LS + IF (L.GT.N) GO TO 40 + L1 = L + 1 + IF (L1.GT.N) GO TO 10 + IF (A(L1,L).EQ.0.) GO TO 10 +C* HERE A 2X2 BLOCK IS CHECKED * + LS = 2 + D = B(L,L)*B(L1,L1) + S = (A(L,L)*B(L1,L1)+A(L1,L1)*B(L,L)-A(L1,L)*B(L,L1))/D + P = (A(L,L)*A(L1,L1)-A(L,L1)*A(L1,L))/D + IS = FTEST(LS,ALPHA,BETA,S,P) + GO TO 20 +C* HERE A 1X1 BLOCK IS CHECKED * + 10 LS = 1 + IS = FTEST(LS,A(L,L),B(L,L),S,P) + 20 NUM = NUM + 1 + IF (IS.EQ.1) NDIM = NDIM + LS + IND(NUM) = LS*IS + 30 CONTINUE +C*** REORDER BLOCKS SUCH THAT THOSE WITH POSITIVE VALUE +C*** OF IND(.) APPEAR FIRST. + 40 L2I = 1 + DO 100 I=1,NUM + IF (IND(I).GT.0) GO TO 90 +C* IF A NEGATIVE IND(I) IS ENCOUNTERED, THEN SEARCH FOR THE FIRST +C* POSITIVE IND(K) FOLLOWING ON IT + L2K = L2I + DO 60 K=I,NUM + IF (IND(K).LT.0) GO TO 50 + GO TO 70 + 50 L2K = L2K - IND(K) + 60 CONTINUE +C* IF THERE ARE NO POSITIVE INDICES FOLLOWING ON A NEGATIVE ONE +C* THEN STOP + GO TO 110 +C* IF A POSITIVE IND(K) FOLLOWS ON A NEGATIVE IND(I) THEN +C* INTERCHANGE BLOCK K BEFORE BLOCK I BY PERFORMING K-I SWAPS + 70 ISTEP = K - I + LS2 = IND(K) + L = L2K + DO 80 II=1,ISTEP + IFIRST = K - II + LS1 = -IND(IFIRST) + L = L - LS1 + CALL EXCHQZ(NMAX, N, A, B, Z, L, LS1, LS2, EPS, FAIL) + IF (FAIL) RETURN + IND(IFIRST+1) = IND(IFIRST) + 80 CONTINUE + IND(I) = LS2 + 90 L2I = L2I + IND(I) + 100 CONTINUE + 110 FAIL = .FALSE. + RETURN + END
new file mode 100644 --- /dev/null +++ b/libcruft/ordered-qz/exchqz.f @@ -0,0 +1,263 @@ + SUBROUTINE EXCHQZ(NMAX, N, A, B, Z, L, LS1, LS2, EPS, FAIL) + INTEGER NMAX, N, L, LS1, LS2 + DOUBLE PRECISION A(NMAX,N), B(NMAX,N), Z(NMAX,N), EPS + LOGICAL FAIL +c modified july 9, 1998 a.s.hodel@eng.auburn.edu: +c REAL changed to DOUBLE PRECISION +c calls to AMAX1 changed to call MAX instead. +c calls to SROT changed to DROT (both in BLAS) +c calls to giv changed to dlartg (LAPACK); required new variable tempr +C* +C* GIVEN THE UPPER TRIANGULAR MATRIX B AND UPPER HESSENBERG MATRIX A +C* WITH CONSECUTIVE LS1XLS1 AND LS2XLS2 DIAGONAL BLOCKS (LS1,LS2.LE.2) +C* STARTING AT ROW/COLUMN L, EXCHQZ PRODUCES EQUIVALENCE TRANSFORMA- +C* TIONS QT AND ZT THAT EXCHANGE THE BLOCKS ALONG WITH THEIR GENERALIZED +C* EIGENVALUES. EXCHQZ REQUIRES THE SUBROUTINES DROT (BLAS) AND GIV. +C* THE PARAMETERS IN THE CALLING SEQUENCE ARE (STARRED PARAMETERS ARE +C* ALTERED BY THE SUBROUTINE): +C* +C* NMAX THE FIRST DIMENSION OF A, B AND Z +C* N THE ORDER OF A, B AND Z +C* *A,*B THE MATRIX PAIR WHOSE BLOCKS ARE TO BE INTERCHANGED +C* *Z UPON RETURN THIS ARRAY IS MULTIPLIED BY THE COLUMN +C* TRANSFORMATION ZT. +C* L THE POSITION OF THE BLOCKS +C* LS1 THE SIZE OF THE FIRST BLOCK +C* LS2 THE SIZE OF THE SECOND BLOCK +C* EPS THE REQUIRED ABSOLUTE ACCURACY OF THE RESULT +C* *FAIL A LOGICAL VARIABLE WHICH IS FALSE ON A NORMAL RETURN, +C* TRUE OTHERWISE. +C* + INTEGER I, J, L1, L2, L3, LI, LJ, LL, IT1, IT2 + DOUBLE PRECISION U(3,3), D, E, F, G, SA, SB, A11B11, A21B11, + * A12B22, B12B22, + * A22B22, AMMBMM, ANMBMM, AMNBNN, BMNBNN, ANNBNN, TEMPR + LOGICAL ALTB + FAIL = .FALSE. + L1 = L + 1 + LL = LS1 + LS2 + IF (LL.GT.2) GO TO 10 +C*** INTERCHANGE 1X1 AND 1X1 BLOCKS VIA AN EQUIVALENCE +C*** TRANSFORMATION A:=Q*A*Z , B:=Q*B*Z +C*** WHERE Q AND Z ARE GIVENS ROTATIONS + F = MAX(ABS(A(L1,L1)),ABS(B(L1,L1))) + ALTB = .TRUE. + IF (ABS(A(L1,L1)).GE.F) ALTB = .FALSE. + SA = A(L1,L1)/F + SB = B(L1,L1)/F + F = SA*B(L,L) - SB*A(L,L) +C* CONSTRUCT THE COLUMN TRANSFORMATION Z + G = SA*B(L,L1) - SB*A(L,L1) + CALL DLARTG(F, G, D, E,TEMPR) + CALL DROT(L1, A(1,L), 1, A(1,L1), 1, E, -D) + CALL DROT(L1, B(1,L), 1, B(1,L1), 1, E, -D) + CALL DROT(N, Z(1,L), 1, Z(1,L1), 1, E, -D) +C* CONSTRUCT THE ROW TRANSFORMATION Q + IF (ALTB) CALL DLARTG(B(L,L), B(L1,L), D, E,TEMPR) + IF (.NOT.ALTB) CALL DLARTG(A(L,L), A(L1,L), D, E,TEMPR) + CALL DROT(N-L+1, A(L,L), NMAX, A(L1,L), NMAX, D, E) + CALL DROT(N-L+1, B(L,L), NMAX, B(L1,L), NMAX, D, E) + A(L1,L) = 0. + B(L1,L) = 0. + RETURN +C*** INTERCHANGE 1X1 AND 2X2 BLOCKS VIA AN EQUIVALENCE +C*** TRANSFORMATION A:=Q2*Q1*A*Z1*Z2 , B:=Q2*Q1*B*Z1*Z2 +C*** WHERE EACH QI AND ZI IS A GIVENS ROTATION + 10 L2 = L + 2 + IF (LS1.EQ.2) GO TO 60 + G = MAX(ABS(A(L,L)),ABS(B(L,L))) + ALTB = .TRUE. + IF (ABS(A(L,L)).LT.G) GO TO 20 + ALTB = .FALSE. + CALL DLARTG(A(L1,L1), A(L2,L1), D, E,TEMPR) + CALL DROT(N-L, A(L1,L1), NMAX, A(L2,L1), NMAX, D, E) + CALL DROT(N-L, B(L1,L1), NMAX, B(L2,L1), NMAX, D, E) +C** EVALUATE THE PENCIL AT THE EIGENVALUE CORRESPONDING +C** TO THE 1X1 BLOCK + 20 SA = A(L,L)/G + SB = B(L,L)/G + DO 40 J=1,2 + LJ = L + J + DO 30 I=1,3 + LI = L + I - 1 + U(I,J) = SA*B(LI,LJ) - SB*A(LI,LJ) + 30 CONTINUE + 40 CONTINUE + CALL DLARTG(U(3,1), U(3,2), D, E,TEMPR) + CALL DROT(3, U(1,1), 1, U(1,2), 1, E, -D) +C* PERFORM THE ROW TRANSFORMATION Q1 + CALL DLARTG(U(1,1), U(2,1), D, E,TEMPR) + U(2,2) = -U(1,2)*E + U(2,2)*D + CALL DROT(N-L+1, A(L,L), NMAX, A(L1,L), NMAX, D, E) + CALL DROT(N-L+1, B(L,L), NMAX, B(L1,L), NMAX, D, E) +C* PERFORM THE COLUMN TRANSFORMATION Z1 + IF (ALTB) CALL DLARTG(B(L1,L), B(L1,L1), D, E,TEMPR) + IF (.NOT.ALTB) CALL DLARTG(A(L1,L), A(L1,L1), D, E,TEMPR) + CALL DROT(L2, A(1,L), 1, A(1,L1), 1, E, -D) + CALL DROT(L2, B(1,L), 1, B(1,L1), 1, E, -D) + CALL DROT(N, Z(1,L), 1, Z(1,L1), 1, E, -D) +C* PERFORM THE ROW TRANSFORMATION Q2 + CALL DLARTG(U(2,2), U(3,2), D, E,TEMPR) + CALL DROT(N-L+1, A(L1,L), NMAX, A(L2,L), NMAX, D, E) + CALL DROT(N-L+1, B(L1,L), NMAX, B(L2,L), NMAX, D, E) +C* PERFORM THE COLUMN TRANSFORMATION Z2 + IF (ALTB) CALL DLARTG(B(L2,L1), B(L2,L2), D, E,TEMPR) + IF (.NOT.ALTB) CALL DLARTG(A(L2,L1), A(L2,L2), D, E,TEMPR) + CALL DROT(L2, A(1,L1), 1, A(1,L2), 1, E, -D) + CALL DROT(L2, B(1,L1), 1, B(1,L2), 1, E, -D) + CALL DROT(N, Z(1,L1), 1, Z(1,L2), 1, E, -D) + IF (ALTB) GO TO 50 + CALL DLARTG(B(L,L), B(L1,L), D, E,TEMPR) + CALL DROT(N-L+1, A(L,L), NMAX, A(L1,L), NMAX, D, E) + CALL DROT(N-L+1, B(L,L), NMAX, B(L1,L), NMAX, D, E) +C* PUT THE NEGLECTABLE ELEMENTS EQUAL TO ZERO + 50 A(L2,L) = 0. + A(L2,L1) = 0. + B(L1,L) = 0. + B(L2,L) = 0. + B(L2,L1) = 0. + RETURN +C*** INTERCHANGE 2X2 AND 1X1 BLOCKS VIA AN EQUIVALENCE +C*** TRANSFORMATION A:=Q2*Q1*A*Z1*Z2 , B:=Q2*Q1*B*Z1*Z2 +C*** WHERE EACH QI AND ZI IS A GIVENS ROTATION + 60 IF (LS2.EQ.2) GO TO 110 + G = MAX(ABS(A(L2,L2)),ABS(B(L2,L2))) + ALTB = .TRUE. + IF (ABS(A(L2,L2)).LT.G) GO TO 70 + ALTB = .FALSE. + CALL DLARTG(A(L,L), A(L1,L), D, E,TEMPR) + CALL DROT(N-L+1, A(L,L), NMAX, A(L1,L), NMAX, D, E) + CALL DROT(N-L+1, B(L,L), NMAX, B(L1,L), NMAX, D, E) +C** EVALUATE THE PENCIL AT THE EIGENVALUE CORRESPONDING +C** TO THE 1X1 BLOCK + 70 SA = A(L2,L2)/G + SB = B(L2,L2)/G + DO 90 I=1,2 + LI = L + I - 1 + DO 80 J=1,3 + LJ = L + J - 1 + U(I,J) = SA*B(LI,LJ) - SB*A(LI,LJ) + 80 CONTINUE + 90 CONTINUE + CALL DLARTG(U(1,1), U(2,1), D, E,TEMPR) + CALL DROT(3, U(1,1), 3, U(2,1), 3, D, E) +C* PERFORM THE COLUMN TRANSFORMATION Z1 + CALL DLARTG(U(2,2), U(2,3), D, E,TEMPR) + U(1,2) = U(1,2)*E - U(1,3)*D + CALL DROT(L2, A(1,L1), 1, A(1,L2), 1, E, -D) + CALL DROT(L2, B(1,L1), 1, B(1,L2), 1, E, -D) + CALL DROT(N, Z(1,L1), 1, Z(1,L2), 1, E, -D) +C* PERFORM THE ROW TRANSFORMATION Q1 + IF (ALTB) CALL DLARTG(B(L1,L1), B(L2,L1), D, E,TEMPR) + IF (.NOT.ALTB) CALL DLARTG(A(L1,L1), A(L2,L1), D, E,TEMPR) + CALL DROT(N-L+1, A(L1,L), NMAX, A(L2,L), NMAX, D, E) + CALL DROT(N-L+1, B(L1,L), NMAX, B(L2,L), NMAX, D, E) +C* PERFORM THE COLUMN TRANSFORMATION Z2 + CALL DLARTG(U(1,1), U(1,2), D, E,TEMPR) + CALL DROT(L2, A(1,L), 1, A(1,L1), 1, E, -D) + CALL DROT(L2, B(1,L), 1, B(1,L1), 1, E, -D) + CALL DROT(N, Z(1,L), 1, Z(1,L1), 1, E, -D) +C* PERFORM THE ROW TRANSFORMATION Q2 + IF (ALTB) CALL DLARTG(B(L,L), B(L1,L), D, E,TEMPR) + IF (.NOT.ALTB) CALL DLARTG(A(L,L), A(L1,L), D, E,TEMPR) + CALL DROT(N-L+1, A(L,L), NMAX, A(L1,L), NMAX, D, E) + CALL DROT(N-L+1, B(L,L), NMAX, B(L1,L), NMAX, D, E) + IF (ALTB) GO TO 100 + CALL DLARTG(B(L1,L1), B(L2,L1), D, E,TEMPR) + CALL DROT(N-L, A(L1,L1), NMAX, A(L2,L1), NMAX, D, E) + CALL DROT(N-L, B(L1,L1), NMAX, B(L2,L1), NMAX, D, E) +C* PUT THE NEGLECTABLE ELEMENTS EQUAL TO ZERO + 100 A(L1,L) = 0. + A(L2,L) = 0. + B(L1,L) = 0. + B(L2,1) = 0. + B(L2,L1) = 0. + RETURN +C*** INTERCHANGE 2X2 AND 2X2 BLOCKS VIA A SEQUENCE OF +C*** QZ-STEPS REALIZED BY THE EQUIVALENCE TRANSFORMATIONS +C*** A:=Q5*Q4*Q3*Q2*Q1*A*Z1*Z2*Z3*Z4*Z5 +C*** B:=Q5*Q4*Q3*Q2*Q1*B*Z1*Z2*Z3*Z4*Z5 +C*** WHERE EACH QI AND ZI IS A GIVENS ROTATION + 110 L3 = L + 3 +C* COMPUTE IMPLICIT SHIFT + AMMBMM = A(L,L)/B(L,L) + ANMBMM = A(L1,L)/B(L,L) + AMNBNN = A(L,L1)/B(L1,L1) + ANNBNN = A(L1,L1)/B(L1,L1) + BMNBNN = B(L,L1)/B(L1,L1) + DO 130 IT1=1,3 + U(1,1) = 1. + U(2,1) = 1. + U(3,1) = 1. + DO 120 IT2=1,10 +C* PERFORM ROW TRANSFORMATIONS Q1 AND Q2 + CALL DLARTG(U(2,1), U(3,1), D, E,TEMPR) + CALL DROT(N-L+1, A(L1,L), NMAX, A(L2,L), NMAX, D, E) + CALL DROT(N-L, B(L1,L1), NMAX, B(L2,L1), NMAX, D, E) + U(2,1) = D*U(2,1) + E*U(3,1) + CALL DLARTG(U(1,1), U(2,1), D, E,TEMPR) + CALL DROT(N-L+1, A(L,L), NMAX, A(L1,L), NMAX, D, E) + CALL DROT(N-L+1, B(L,L), NMAX, B(L1,L), NMAX, D, E) +C* PERFORM COLUMN TRANSFORMATIONS Z1 AND Z2 + CALL DLARTG(B(L2,L1), B(L2,L2), D, E,TEMPR) + CALL DROT(L3, A(1,L1), 1, A(1,L2), 1, E, -D) + CALL DROT(L2, B(1,L1), 1, B(1,L2), 1, E, -D) + CALL DROT(N, Z(1,L1), 1, Z(1,L2), 1, E, -D) + CALL DLARTG(B(L1,L), B(L1,L1), D, E,TEMPR) + CALL DROT(L3, A(1,L), 1, A(1,L1), 1, E, -D) + CALL DROT(L1, B(1,L), 1, B(1,L1), 1, E, -D) + CALL DROT(N, Z(1,L), 1, Z(1,L1), 1, E, -D) +C* PERFORM TRANSFORMATIONS Q3,Z3,Q4,Z4,Q5 AND Z5 IN +C* ORDER TO REDUCE THE PENCIL TO HESSENBERG FORM + CALL DLARTG(A(L2,L), A(L3,L), D, E,TEMPR) + CALL DROT(N-L+1, A(L2,L), NMAX, A(L3,L), NMAX, D, E) + CALL DROT(N-L1, B(L2,L2), NMAX, B(L3,L2), NMAX, D, E) + CALL DLARTG(B(L3,L2), B(L3,L3), D, E,TEMPR) + CALL DROT(L3, A(1,L2), 1, A(1,L3), 1, E, -D) + CALL DROT(L3, B(1,L2), 1, B(1,L3), 1, E, -D) + CALL DROT(N, Z(1,L2), 1, Z(1,L3), 1, E, -D) + CALL DLARTG(A(L1,L), A(L2,L), D, E,TEMPR) + CALL DROT(N-L+1, A(L1,L), NMAX, A(L2,L), NMAX, D, E) + CALL DROT(N-L, B(L1,L1), NMAX, B(L2,L1), NMAX, D, E) + CALL DLARTG(B(L2,L1), B(L2,L2), D, E,TEMPR) + CALL DROT(L3, A(1,L1), 1, A(1,L2), 1, E, -D) + CALL DROT(L2, B(1,L1), 1, B(1,L2), 1, E, -D) + CALL DROT(N, Z(1,L1), 1, Z(1,L2), 1, E, -D) + CALL DLARTG(A(L2,L1), A(L3,L1), D, E,TEMPR) + CALL DROT(N-L, A(L2,L1), NMAX, A(L3,L1), NMAX, D, E) + CALL DROT(N-L1, B(L2,L2), NMAX, B(L3,L2), NMAX, D, E) + CALL DLARTG(B(L3,L2), B(L3,L3), D, E,TEMPR) + CALL DROT(L3, A(1,L2), 1, A(1,L3), 1, E, -D) + CALL DROT(L3, B(1,L2), 1, B(1,L3), 1, E, -D) + CALL DROT(N, Z(1,L2), 1, Z(1,L3), 1, E, -D) +C* TEST OF CONVERGENCE ON THE ELEMENT SEPARATING THE BLOCKS + IF (ABS(A(L2,L1)).LE.EPS) GO TO 140 +C* COMPUTE A NEW SHIFT IN CASE OF NO CONVERGENCE + A11B11 = A(L,L)/B(L,L) + A12B22 = A(L,L1)/B(L1,L1) + A21B11 = A(L1,L)/B(L,L) + A22B22 = A(L1,L1)/B(L1,L1) + B12B22 = B(L,L1)/B(L1,L1) + U(1,1) = ((AMMBMM-A11B11)*(ANNBNN-A11B11)-AMNBNN* + * ANMBMM+ANMBMM*BMNBNN*A11B11)/A21B11 + A12B22 - A11B11*B12B22 + U(2,1) = (A22B22-A11B11) - A21B11*B12B22 - (AMMBMM-A11B11) - + * (ANNBNN-A11B11) + ANMBMM*BMNBNN + U(3,1) = A(L2,L1)/B(L1,L1) + 120 CONTINUE + 130 CONTINUE + FAIL = .TRUE. + RETURN +C* PUT THE NEGLECTABLE ELEMENTS EQUAL TO ZERO IN +C* CASE OF CONVERGENCE + 140 A(L2,L) = 0. + A(L2,L1) = 0. + A(L3,L) = 0. + A(L3,L1) = 0. + B(L1,L) = 0. + B(L2,L) = 0. + B(L2,L1) = 0. + B(L3,L) = 0. + B(L3,L1) = 0. + B(L3,L2) = 0. + RETURN + END
--- a/liboctave/Array2-idx.h +++ b/liboctave/Array2-idx.h @@ -628,7 +628,14 @@ if (idx) { - if (len == rhs_nr * rhs_nc) + if (len == 0) + { + if (! ((rhs_nr == 1 && rhs_nc == 1) + || (rhs_nr == 0 && rhs_nc == 0))) + (*current_liboctave_error_handler) + ("A([]) = X: X must be an empty matrix or scalar"); + } + else if (len == rhs_nr * rhs_nc) { int k = 0; for (int j = 0; j < rhs_nc; j++) @@ -642,12 +649,17 @@ } } } - else if (len == 0) + else if (rhs_nr == 1 && rhs_nc == 1 && len <= lhs_nr * lhs_nc) { - if (! ((rhs_nr == 1 && rhs_nc == 1) - || (rhs_nr == 0 && rhs_nc == 0))) - (*current_liboctave_error_handler) - ("A([]) = X: X must be an empty matrix or scalar"); + RT scalar = rhs.elem (0, 0); + + for (int i = 0; i < len; i++) + { + int ii = idx.elem (i); + int fr = ii % lhs_nr; + int fc = (ii - fr) / lhs_nr; + lhs.elem (fr, fc) = scalar; + } } else {
--- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -164,6 +164,7 @@ // here? ComplexMatrix::ComplexMatrix (const boolMatrix& a) + : MArray2<Complex> (a.rows (), a.cols (), 0.0) { for (int i = 0; i < a.cols (); i++) for (int j = 0; j < a.rows (); j++) @@ -171,6 +172,7 @@ } ComplexMatrix::ComplexMatrix (const charMatrix& a) + : MArray2<Complex> (a.rows (), a.cols (), 0.0) { for (int i = 0; i < a.cols (); i++) for (int j = 0; j < a.rows (); j++)
--- a/liboctave/ChangeLog +++ b/liboctave/ChangeLog @@ -1,3 +1,29 @@ +Thu Sep 24 13:23:25 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * lo-ieee.cc (octave_ieee_init): For now, use X_CAST instead of + static_cast. + +Fri Sep 4 10:58:22 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * dMatrix.cc (Matrix::read): Skip after reading, not before. + From: Dr.-Ing. Torsten Finke <fi@igh-essen.com>. + +Wed Sep 2 09:50:21 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * lo-ieee.cc (octave_ieee_init): For Linux on arm, don't rely on + HUGE_VAL and NAN. + +Wed Aug 26 15:04:57 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * Array2-idx.h (assign (Array2<LT>& lhs, const Array2<RT>& rhs)): + Handle x(i) = scalar for do_fortran_indexing == 1. + +Thu Jul 30 00:34:10 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * CMatrix.cc (ComplexMatrix::ComplexMatrix (const charMatrix&)): + Alloctate space before attempting to use it. + (ComplexMatrix::ComplexMatrix (const boolMatrix&)): Likewise. + Mon Jun 22 17:04:27 1998 Tomislav Goles <tom@ait-tech.com> * EIG.cc (EIG::init): Move invariant code outside loop.
--- a/liboctave/dMatrix.cc +++ b/liboctave/dMatrix.cc @@ -2599,9 +2599,6 @@ break; } - if (skip != 0) - is.seekg (skip, ios::cur); - if (is) { double tmp = 0.0; @@ -2627,7 +2624,11 @@ data[count++] = tmp; } - else + + if (ok && skip != 0) + is.seekg (skip, ios::cur); + + if (! ok) { if (is.eof ()) {
--- a/liboctave/lo-ieee.cc +++ b/liboctave/lo-ieee.cc @@ -69,10 +69,14 @@ double tmp = 1.0; octave_Inf = 1.0 / (tmp - tmp); #elif defined (linux) +#if defined (HUGE_VAL) && ! defined (arm) octave_Inf = HUGE_VAL; +#else + octave_Inf = 1.0/0.0; +#endif #elif defined (__alpha__) extern unsigned int DINFINITY[2]; - octave_Inf = (*(static_cast<double *> (DINFINITY))); + octave_Inf = (*(X_CAST(double *, DINFINITY))); #elif defined (HAVE_INFINITY) octave_Inf = infinity (); #else @@ -92,10 +96,14 @@ #if defined (HAVE_ISNAN) #if defined (linux) +#if defined (NAN) && ! defined (arm) octave_NaN = NAN; +#else + octave_NaN = 0.0/0.0; +#endif #elif defined (__alpha__) extern unsigned int DQNAN[2]; - octave_NaN = (*(static_cast<double *> (DQNAN))); + octave_NaN = (*(X_CAST(double *, DQNAN))); #elif defined (HAVE_QUIET_NAN) octave_NaN = quiet_nan (0L); #else
--- a/mkoctfile.in +++ b/mkoctfile.in @@ -44,6 +44,7 @@ octfiles= octfile= incflags= +defs= ldflags= dbg=: strip=false @@ -83,6 +84,7 @@ -h, -? --help Print this message. -IDIR Add -IDIR to compile commands. + -DDEF Add -DDEF to compile commands. -lLIB Add library LIB to link command. -LDIR Add -LDIR to link command. -o FILE, --output FILE Output file name. Default extension is .oct. @@ -105,6 +107,9 @@ -I*) incflags="$incflags $1" ;; + -D*) + defs="$defs $1" + ;; -[lL]*) ldflags="$ldflags $1" ;; @@ -157,8 +162,8 @@ b=`echo $f | sed 's,\.c$,,'` o=$b.o objfiles="$objfiles $o" - $dbg $CC -c $CPPFLAGS $CPICFLAG $ALL_CFLAGS $incflags $f -o $o - eval $CC -c $CPPFLAGS $CPICFLAG $ALL_CFLAGS $incflags $f -o $o + $dbg $CC -c $CPPFLAGS $CPICFLAG $ALL_CFLAGS $incflags $defs $f -o $o + eval $CC -c $CPPFLAGS $CPICFLAG $ALL_CFLAGS $incflags $defs $f -o $o done fi @@ -177,8 +182,8 @@ esac o=$b.o objfiles="$objfiles $o" - $dbg $CXX -c $CPPFLAGS $CXXPICFLAG $ALL_CXXFLAGS $incflags $f -o $o - eval $CXX -c $CPPFLAGS $CXXPICFLAG $ALL_CXXFLAGS $incflags $f -o $o + $dbg $CXX -c $CPPFLAGS $CXXPICFLAG $ALL_CXXFLAGS $incflags $defs $f -o $o + eval $CXX -c $CPPFLAGS $CXXPICFLAG $ALL_CXXFLAGS $incflags $defs $f -o $o done fi
--- a/readline/ChangeLog +++ b/readline/ChangeLog @@ -1,3 +1,7 @@ +Mon Aug 31 12:07:02 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * config.sub: Accept armv4 everywhere arm is allowed. + Wed Mar 4 14:59:11 1998 John W. Eaton <jwe@bevo.che.wisc.edu> * parens.c (rl_insert_close): Make time delay for showing matching
--- a/readline/support/config.sub +++ b/readline/support/config.sub @@ -149,7 +149,7 @@ case $basic_machine in # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. - tahoe | i860 | m68k | m68000 | m88k | ns32k | arm \ + tahoe | i860 | m68k | m68000 | m88k | ns32k | arm | armv4 \ | arme[lb] | pyramid \ | tron | a29k | 580 | i960 | h8300 | hppa | hppa1.0 | hppa1.1 \ | alpha | we32k | ns16k | clipper | i370 | sh \ @@ -171,7 +171,7 @@ ;; # Recognize the basic CPU types with company name. vax-* | tahoe-* | i[3456]86-* | i860-* | m68k-* | m68000-* | m88k-* \ - | sparc-* | ns32k-* | fx80-* | arm-* | c[123]* \ + | sparc-* | ns32k-* | fx80-* | arm-* | armv4-* | c[123]* \ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* | power-* \ | none-* | 580-* | cray2-* | h8300-* | i960-* | xmp-* | ymp-* \ | hppa-* | hppa1.0-* | hppa1.1-* | alpha-* | we32k-* | cydra-* | ns16k-* \
--- a/scripts/ChangeLog +++ b/scripts/ChangeLog @@ -1,3 +1,18 @@ +Thu Sep 3 12:40:47 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * strings/str2num.m: If eval returns a string, return an empty matrix. + + * strings/strrep.m: Don't convert args to numeric values. + Prevent warnings for empty string args. + From Georg Thimm <thimm@idiap.ch>. + + * strings/strcat.m: Prevent warnings for empty string args. + +Wed Sep 2 17:20:24 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * miscellaneous/menu.m: Remove special case for empty string + returned from input(). Add second arg to eval() to catch errors. + Thu Jun 18 16:32:15 1998 John W. Eaton <jwe@bevo.che.wisc.edu> * plot/__plt__.m: Don't call usleep.
--- a/scripts/miscellaneous/menu.m +++ b/scripts/miscellaneous/menu.m @@ -56,13 +56,8 @@ disp (va_arg ()); endfor printf ("\n"); - s = ""; s = input ("pick a number, any number: ", "s"); - if (strcmp (s, "")) - printf ("\n"); - continue; - endif - eval (sprintf ("num = %s;", s)); + eval (sprintf ("num = %s;", s), "num = [];"); if (! is_scalar (num) || num < 1 || num > nopt) printf ("\nerror: input invalid or out of range\n\n"); else
--- a/scripts/strings/str2num.m +++ b/scripts/strings/str2num.m @@ -31,6 +31,9 @@ sep = sep (ones (nr, 1), 1); s = sprintf ("m = [%s];", reshape ([s, sep]', 1, nr * (nc + 1))); eval (s, "m = [];"); + if (isstr (m)) + m = []; + endif else usage ("str2num (s)"); endif
--- a/scripts/strings/strcat.m +++ b/scripts/strings/strcat.m @@ -26,20 +26,26 @@ function st = strcat (s, t, ...) if (nargin > 1) - if (isstr (s) && isstr (t)) - tmpst = [s, t]; - else - error ("strcat: all arguments must be strings"); - endif - n = nargin - 2; - while (n--) - tmp = va_arg (); - if (isstr (tmp)) - tmpst = [tmpst, tmp]; + save_empty_list_elements_ok = empty_list_elements_ok; + unwind_protect + empty_list_elements_ok = 1; + if (isstr (s) && isstr (t)) + tmpst = [s, t]; else - error ("strcat: all arguments must be strings"); + error ("strcat: all arguments must be strings"); endif - endwhile + n = nargin - 2; + while (n--) + tmp = va_arg (); + if (isstr (tmp)) + tmpst = [tmpst, tmp]; + else + error ("strcat: all arguments must be strings"); + endif + endwhile + unwind_protect_cleanup + empty_list_elements_ok = save_empty_list_elements_ok; + end_unwind_protect else usage ("strcat (s, t, ...)"); endif
--- a/scripts/strings/strrep.m +++ b/scripts/strings/strrep.m @@ -46,20 +46,21 @@ if (len == 0) t = s; else - s = toascii (s); - x = toascii (x); - y = toascii (y); - - l_x = length (x); - tmp = s (1 : ind (1) - 1); - t = [tmp, y]; - for k = 1 : len - 1 - tmp = s (ind (k) + l_x : ind (k+1) - 1); - t = [t, tmp, y]; - endfor - tmp = s (ind(len) + l_x : length (s)); - t = [t, tmp]; - t = setstr (t); + save_empty_list_elements_ok = empty_list_elements_ok; + unwind_protect + empty_list_elements_ok = 1; + l_x = length (x); + tmp = s (1 : ind (1) - 1); + t = strcat (tmp, y); + for k = 1 : len - 1 + tmp = s (ind (k) + l_x : ind (k+1) - 1); + t = strcat (t, tmp, y); + endfor + tmp = s (ind(len) + l_x : length (s)); + t = [t, tmp]; + unwind_protect_cleanup + empty_list_elements_ok = save_empty_list_elements_ok; + end_unwind_protect endif endfunction
--- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,63 @@ +Thu Sep 24 10:48:12 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * parse.y (plot_command1): Don't allow it to be empty. + (plot_command): Handle simple `PLOT' and `PLOT ranges' as special + cases here. + +Wed Sep 23 21:10:08 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * lex.l: Change <MATRIX>{SNLCMT}*\n{SNLCMT}* pattern + to <MATRIX>{S}*{COMMENT}{SNLCMT}* | <MATRIX>{S}*{NL}{SNLCMT}*. + +Fri Sep 4 10:50:00 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * file-io.cc (Ffwrite): Fix doc string. + +Wed Sep 2 16:22:23 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * input.cc (match_sans_spaces): Make it work. + + * toplev.cc (quit): Require nargout == 0. + + * input.cc (get_user_input): Only try matching "exit", "quit", and + "return" if debugging. + +Tue Sep 1 12:50:24 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * octave.cc: Use -H as single character equivalent of --no-history. + +Sat Aug 29 12:23:12 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * oct-obj.cc (octave_value_list::make_argv): If some values are + string vectors, insert all the elements, not just the first. + +Tue Aug 18 16:39:50 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * oct-stream.cc (octave_base_stream::do_gets): Accept last line of + file even if it doesn't end in a newline character. + +Tue Aug 18 16:25:49 1998 Mumit Khan <khan@xraylith.wisc.edu> + + * xdiv.cc (mx_leftdiv_conform, mx_div_conform): Instantiate correct + templates. + +Thu Jul 30 00:37:43 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * pt-loop.cc (tree_for_command::eval): Check for range first. + If error occurs when extracting matrix value, return early. + Don't bother to check for string type. + + * ov-ch-mat.h (octave_char_matrix::is_real_matrix): New function. + +Tue Jun 23 15:09:54 1998 John W. Eaton <jwe@bevo.che.wisc.edu> + + * parse.y (clear_current_script_file_name): New function. + (parse_fcn_file): Bind current_script_file_name while script is + executing. Use unwind_protect to clear it once the script is + finished. + + * pt-plot.cc (Fgraw): New function. + Mon Jun 22 22:13:38 1998 John W. Eaton <jwe@bevo.che.wisc.edu> * variables.cc (is_valid_function): Provide version that takes
--- a/src/file-io.cc +++ b/src/file-io.cc @@ -944,7 +944,7 @@ int16, integer*2 -- two byte integer\n\ int32, integer*4 -- four byte integer\n\ \n\ - SKIP : number of bytes to skip before each element is read\n\ + SKIP : number of bytes to skip after each element is read\n\ (default is 0)\n\ \n\ ARCH : string specifying the data format for the file. Valid\n\ @@ -1065,7 +1065,7 @@ \n\ DATA : matrix of elements to be written\n\ \n\ - PRECISION : string specifying type of data to read, valid types are\n\ + PRECISION : string specifying type of data to write, valid types are\n\ \n\ char, char*1, integer*1, int8 -- character\n\ schar, signed char -- signed character\n\ @@ -1081,7 +1081,7 @@ int16, integer*2 -- two byte integer\n\ int32, integer*4 -- four byte integer\n\ \n\ - SKIP : number of bytes to skip before each element is read\n\ + SKIP : number of bytes to skip before each element is written\n\ (the default is 0)\n\ \n\ ARCH : string specifying the data format for the file. Valid\n\
--- a/src/input.cc +++ b/src/input.cc @@ -473,13 +473,18 @@ static bool match_sans_spaces (const string& standard, const string& test) { - string tmp = test; + size_t beg = test.find_first_not_of (" \t"); + + if (beg != NPOS) + { + size_t end = test.find_last_not_of (" \t"); - size_t beg = test.find_first_not_of (" \t"); - size_t end = test.find_last_not_of (" \t"); - size_t len = beg - end + 1; + size_t len = end == NPOS ? NPOS : end - beg + 1; - return test.compare (standard, beg, len) == 0; + return test.compare (standard, beg, len) == 0; + } + + return false; } // If the user simply hits return, this will produce an empty matrix. @@ -535,9 +540,10 @@ } } - if (match_sans_spaces ("exit", input_buf) - || match_sans_spaces ("quit", input_buf) - || match_sans_spaces ("return", input_buf)) + if (debug + && (match_sans_spaces ("exit", input_buf) + || match_sans_spaces ("quit", input_buf) + || match_sans_spaces ("return", input_buf))) { return retval; }
--- a/src/lex.l +++ b/src/lex.l @@ -332,7 +332,8 @@ // semicolons. %} -<MATRIX>{SNLCMT}*\n{SNLCMT}* { +<MATRIX>{S}*{COMMENT}{SNLCMT}* | +<MATRIX>{S}*{NL}{SNLCMT}* { fixup_column_count (yytext); eat_whitespace (); if (Vwhitespace_in_literal_matrix != 2)
--- a/src/oct-obj.cc +++ b/src/oct-obj.cc @@ -112,12 +112,32 @@ if (all_strings_p ()) { - int n = length (); - argv.resize (n+1); + int len = length (); + + int total_nr = 0; + + for (int i = 0; i < len; i++) + total_nr += elem(i).rows (); + + argv.resize (total_nr+1); + argv[0] = fcn_name; - for (int i = 0; i < n; i++) - argv[i+1] = elem(i).string_value (); + int k = 1; + for (int i = 0; i < len; i++) + { + int nr = elem(i).rows (); + + if (nr == 1) + argv[k++] = elem(i).string_value (); + else + { + string_vector tmp = elem(i).all_strings (); + + for (int j = 0; j < nr; j++) + argv[k++] = tmp[j]; + } + } } else error ("%s: expecting all arguments to be strings", fcn_name.c_str ());
--- a/src/oct-stream.cc +++ b/src/oct-stream.cc @@ -821,7 +821,7 @@ msg.append (": read error"); error (msg); } - else if (is.eof ()) + else if (count == 0 && is.eof ()) { err = true; string msg = fcn;
--- a/src/octave.cc +++ b/src/octave.cc @@ -104,15 +104,16 @@ // Usage message static const char *usage_string = - "octave [-?Vdfhiqvx] [--debug] [--echo-commands] [--exec-path path]\n\ + "octave [-?HVdfhiqvx] [--debug] [--echo-commands] [--exec-path path]\n\ [--help] [--info-file file] [--info-program prog] [--interactive]\n\ - [--no-init-file] [--no-line-editing] [--no-site-file] [-p path]\n\ - [--path path] [--silent] [--traditional] [--verbose] [--version] [file]"; + [--no-history] [--no-init-file] [--no-line-editing] [--no-site-file]\n\ + [-p path] [--path path] [--silent] [--traditional] [--verbose]\n\ + [--version] [file]"; // This is here so that it's more likely that the usage message and // the real set of options will agree. Note: the `+' must come first // to prevent getopt from permuting arguments! -static const char *short_opts = "+?Vdfhip:qvx"; +static const char *short_opts = "+?HVdfhip:qvx"; // Long options. See the comments in getopt.h for the meanings of the // fields in this structure. @@ -133,6 +134,7 @@ { "info-file", prog_args::required_arg, 0, INFO_FILE_OPTION }, { "info-program", prog_args::required_arg, 0, INFO_PROG_OPTION }, { "interactive", prog_args::no_arg, 0, 'i' }, + { "no-history", prog_args::no_arg, 0, 'H' }, { "no-init-file", prog_args::no_arg, 0, NO_INIT_FILE_OPTION }, { "no-line-editing", prog_args::no_arg, 0, NO_LINE_EDITING_OPTION }, { "no-site-file", prog_args::no_arg, 0, NO_SITE_FILE_OPTION }, @@ -264,22 +266,23 @@ \n\ Options:\n\ \n\ - -d, --debug Enter parser debugging mode.\n\ - -x, --echo-commands Echo commands as they are executed.\n\ + --debug, -d Enter parser debugging mode.\n\ + --echo-commands, -x Echo commands as they are executed.\n\ --exec-path PATH Set path for executing subprograms.\n\ - -h, -?, --help Print short help message and exit.\n\ - -f, --norc Don't read any initialization files.\n\ + --help, -h, -? Print short help message and exit.\n\ + --norc, -f Don't read any initialization files.\n\ --info-file FILE Use top-level info file FILE.\n\ --info-program PROGRAM Use PROGRAM for reading info files.\n\ - -i, --interactive Force interactive behavior.\n\ + --interactive, -i Force interactive behavior.\n\ + --no-history, -H Don't save commands to the history list\n\ --no-init-file Don't read the ~/.octaverc or .octaverc files.\n\ --no-line-editing Don't use readline for command-line editing.\n\ --no-site-file Don't read the site-wide octaverc file.\n\ - -p PATH, --path PATH Set initial LOADPATH to PATH.\n\ - -q, --silent Don't print message at startup.\n\ + --path PATH, -p PATH Set initial LOADPATH to PATH.\n\ + --silent, -q Don't print message at startup.\n\ --traditional Set compatibility variables.\n\ - -V, --verbose Enable verbose output in some cases.\n\ - -v, --version Print version number and exit.\n\ + --verbose, -V Enable verbose output in some cases.\n\ + --version, -v Print version number and exit.\n\ \n\ FILE Execute commands from FILE.\n\ \n\ @@ -383,6 +386,10 @@ { switch (optc) { + case 'H': + bind_builtin_variable ("saving_history", 0.0); + break; + case 'V': verbose_flag = true; break;
--- a/src/ov-ch-mat.h +++ b/src/ov-ch-mat.h @@ -89,6 +89,7 @@ bool is_defined (void) const { return true; } bool is_char_matrix (void) const { return true; } + bool is_real_matrix (void) const { return true; } octave_value all (void) const { return matrix.all (); } octave_value any (void) const { return matrix.any (); }
--- a/src/parse.y +++ b/src/parse.y @@ -1134,7 +1134,17 @@ // Plotting // ======== -plot_command : PLOT plot_command1 +plot_command : PLOT + { + if (! ($$ = make_plot_command ($1, 0, 0))) + ABORT_PARSE; + } + | PLOT ranges + { + if (! ($$ = make_plot_command ($1, $2, 0))) + ABORT_PARSE; + } + | PLOT plot_command1 { if (! ($$ = make_plot_command ($1, 0, $2))) ABORT_PARSE; @@ -1166,9 +1176,7 @@ { $$ = new plot_range (); } ; -plot_command1 : // empty - { $$ = 0; } - | plot_command2 +plot_command1 : plot_command2 { $$ = new subplot_list ($1); } | plot_command1 ',' plot_command2 { @@ -2781,6 +2789,12 @@ command_editor::set_input_stream (static_cast<FILE *> (f)); } +static void +clear_current_script_file_name (void *) +{ + bind_builtin_variable ("current_script_file_name", octave_value ()); +} + static bool parse_fcn_file (const string& ff, bool exec_script, bool force_script = false) { @@ -2881,6 +2895,10 @@ Vsaving_history = false; reading_script_file = true; + unwind_protect::add (clear_current_script_file_name, 0); + + bind_builtin_variable ("current_script_file_name", ff); + parse_and_execute (ffile); script_file_executed = true;
--- a/src/pt-loop.cc +++ b/src/pt-loop.cc @@ -187,7 +187,29 @@ return; } - if (rhs.is_scalar_type ()) + if (rhs.is_range ()) + { + Range rng = rhs.range_value (); + + int steps = rng.nelem (); + double b = rng.base (); + double increment = rng.inc (); + + for (int i = 0; i < steps; i++) + { + double tmp_val = b + i * increment; + + octave_value val (tmp_val); + + bool quit = false; + + do_for_loop_once (ult, val, quit); + + if (quit) + break; + } + } + else if (rhs.is_scalar_type ()) { bool quit = false; @@ -214,6 +236,9 @@ steps = cm_tmp.columns (); } + if (error_state) + return; + if (rhs.is_real_matrix ()) { if (nr == 1) @@ -229,32 +254,6 @@ DO_LOOP (cm_tmp.extract (0, i, nr-1, i)); } } - else if (rhs.is_string ()) - { - gripe_string_invalid (); - } - else if (rhs.is_range ()) - { - Range rng = rhs.range_value (); - - int steps = rng.nelem (); - double b = rng.base (); - double increment = rng.inc (); - - for (int i = 0; i < steps; i++) - { - double tmp_val = b + i * increment; - - octave_value val (tmp_val); - - bool quit = false; - - do_for_loop_once (ult, val, quit); - - if (quit) - break; - } - } else if (rhs.is_map ()) { Octave_map tmp_val (rhs.map_value ());
--- a/src/pt-plot.cc +++ b/src/pt-plot.cc @@ -1023,6 +1023,34 @@ return retval; } + +DEFUN (graw, args, , + "graw (string)\n\ +\n\ +Send STRING directly to gnuplot subprocess.") +{ + octave_value_list retval; + + if (args.length () == 1 && args(0).is_string ()) + { + string cmd = args(0).string_value (); + + if (! (plot_stream && *plot_stream)) + open_plot_stream (); + + if (! error_state) + { + *plot_stream << cmd; + + plot_stream->flush (); + } + } + else + print_usage ("graw"); + + return retval; +} + DEFUN_TEXT (gset, args, , "gset [options]\n\ \n\
--- a/src/toplev.cc +++ b/src/toplev.cc @@ -243,30 +243,33 @@ return retval; } -DEFUN (quit, args, , +DEFUN (quit, args, nargout, "quit (STATUS): exit Octave gracefully, returning STATUS to the system.\n\ \n\ STATUS should be an integer value. If STATUS is missing, 0 is assumed.") { octave_value_list retval; - int exit_status = 0; - - quitting_gracefully = true; - - int nargin = args.length (); - - if (nargin > 0) + if (nargout == 0) { - // XXX FIXME XXX -- need a safe uniform way to do this. + int exit_status = 0; + + quitting_gracefully = true; - double tmp = args(0).double_value (); + if (args.length () > 0) + { + // XXX FIXME XXX -- need a safe uniform way to do this. - if (! error_state && ! xisnan (tmp)) - exit_status = NINT (tmp); + double tmp = args(0).double_value (); + + if (! error_state && ! xisnan (tmp)) + exit_status = NINT (tmp); + } + + clean_up_and_exit (exit_status); } - - clean_up_and_exit (exit_status); + else + error ("quit: invalid number of output arguments"); return retval; }
--- a/src/xdiv.cc +++ b/src/xdiv.cc @@ -70,10 +70,10 @@ return true; } -template bool mx_leftdiv_conform (const Matrix&, const Matrix&); -template bool mx_leftdiv_conform (const Matrix&, const ComplexMatrix&); -template bool mx_leftdiv_conform (const ComplexMatrix&, const ComplexMatrix&); -template bool mx_leftdiv_conform (const ComplexMatrix&, const Matrix&); +template bool mx_leftdiv_conform (Matrix&, Matrix&); +template bool mx_leftdiv_conform (Matrix&, ComplexMatrix&); +template bool mx_leftdiv_conform (ComplexMatrix&, ComplexMatrix&); +template bool mx_leftdiv_conform (ComplexMatrix&, Matrix&); template <class T1, class T2> bool @@ -94,10 +94,10 @@ return true; } -template bool mx_div_conform (const Matrix&, const Matrix&); -template bool mx_div_conform (const Matrix&, const ComplexMatrix&); -template bool mx_div_conform (const ComplexMatrix&, const ComplexMatrix&); -template bool mx_div_conform (const ComplexMatrix&, const Matrix&); +template bool mx_div_conform (Matrix&, Matrix&); +template bool mx_div_conform (Matrix&, ComplexMatrix&); +template bool mx_div_conform (ComplexMatrix&, ComplexMatrix&); +template bool mx_div_conform (ComplexMatrix&, Matrix&); // Right division functions. //