Mercurial > octave-nkf

changeset 4429:c1f6200b5f0e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2003-06-17 04:36:08 by jwe]
author jwe
date Tue, 17 Jun 2003 04:36:08 +0000
parents 067160691cc9
children 1541c3ed2c93
files libcruft/ChangeLog libcruft/dasrt/ddasrt.f libcruft/dassl/ddajac.f libcruft/dassl/ddaslv.f libcruft/dassl/ddassl.f libcruft/misc/quit.cc libcruft/misc/quit.h liboctave/ChangeLog liboctave/DASSL-opts.in liboctave/DASSL.cc liboctave/oct-shlib.cc src/ChangeLog src/pt-except.cc src/sighandlers.cc src/toplev.cc
diffstat 15 files changed, 104 insertions(+), 16 deletions(-) [+]
line wrap: on
line diff
--- a/libcruft/ChangeLog	Mon Jun 16 19:09:11 2003 +0000
+++ b/libcruft/ChangeLog	Tue Jun 17 04:36:08 2003 +0000
@@ -1,5 +1,20 @@
 2003-06-16  John W. Eaton  <jwe@bevo.che.wisc.edu>
 
+	* dasrt/ddasrt.f (DDASRT): Print correct message for invalid MXSTP.
+
+	* dassl/ddassl.f (DDASSL): Handle MXSTP as in DASRT.
+
+	* dassl/ddajac.f (DDAJAC): LIPVT is now 22.
+	* dassl/ddassl.f (DDASSL): Likewise.
+	* dassl/ddaslv.f (DDASLV): Likewise.
+
+	* misc/quit.h (octave_interrupt_hook, octave_bad_alloc_hook):
+	New function pointers.
+	* misc/quit.cc: Initialize them.
+	(octave_throw_interrupt_exception): If octave_interrupt_hook is
+	set, call it.
+	(octave_throw_bad_alloc): Likewise, for octave_bad_alloc_hook.
+
 	* dasrt/ddasrt.f (DDASRT): Set LMXSTP to 21 and LIPVT to 22 to
 	avoid conflict with LLAST in DRCHECK.  Change docs for INFO(12)
 	and LIW.
--- a/libcruft/dasrt/ddasrt.f	Mon Jun 16 19:09:11 2003 +0000
+++ b/libcruft/dasrt/ddasrt.f	Tue Jun 17 04:36:08 2003 +0000
@@ -387,8 +387,8 @@
 C        INFO(12) --Maximum number of steps.
 C          ****   Do you want to let DDASRT use the default limit for
 C                 the number of steps?
-C                 Yes - Set INFO(11) = 0
-C                  No - Set INFO(11) = 1,
+C                 Yes - Set INFO(12) = 0
+C                  No - Set INFO(12) = 1,
 C                       and define the maximum number of steps
 C                       by setting IWORK(21)=MXSTEP
 C
@@ -955,7 +955,7 @@
       MXSTP=500
       IF(INFO(12).EQ.0)GO TO 80
         MXSTP=IWORK(LMXSTP)
-        IF(MXSTP.LT.0)GO TO 703
+        IF(MXSTP.LT.0)GO TO 716
 80      IWORK(LMXSTP)=MXSTP
 C
 C     INITIALIZE COUNTERS
--- a/libcruft/dassl/ddajac.f	Mon Jun 16 19:09:11 2003 +0000
+++ b/libcruft/dassl/ddajac.f	Tue Jun 17 04:36:08 2003 +0000
@@ -73,7 +73,7 @@
       PARAMETER (LML=1)
       PARAMETER (LMU=2)
       PARAMETER (LMTYPE=4)
-      PARAMETER (LIPVT=21)
+      PARAMETER (LIPVT=22)
 C
 C***FIRST EXECUTABLE STATEMENT  DDAJAC
       IER = 0
--- a/libcruft/dassl/ddaslv.f	Mon Jun 16 19:09:11 2003 +0000
+++ b/libcruft/dassl/ddaslv.f	Tue Jun 17 04:36:08 2003 +0000
@@ -38,7 +38,7 @@
       PARAMETER (LML=1)
       PARAMETER (LMU=2)
       PARAMETER (LMTYPE=4)
-      PARAMETER (LIPVT=21)
+      PARAMETER (LIPVT=22)
 C
 C***FIRST EXECUTABLE STATEMENT  DDASLV
       MTYPE=IWM(LMTYPE)
--- a/libcruft/dassl/ddassl.f	Mon Jun 16 19:09:11 2003 +0000
+++ b/libcruft/dassl/ddassl.f	Tue Jun 17 04:36:08 2003 +0000
@@ -435,7 +435,7 @@
 C         your calling program.
 C
 C  LIW -- Set it to the declared length of the IWORK array.
-C               You must have LIW .GE. 20+NEQ
+C               You must have LIW .GE. 21+NEQ
 C
 C  RPAR, IPAR -- These are parameter arrays, of real and integer
 C         type, respectively.  You can use them for communication
@@ -942,7 +942,8 @@
 C     Declare local variables.
 C
       INTEGER  I, ITEMP, LALPHA, LBETA, LCJ, LCJOLD, LCTF, LDELTA,
-     *   LENIW, LENPD, LENRW, LE, LETF, LGAMMA, LH, LHMAX, LHOLD, LIPVT,
+     *   LENIW, LENPD, LENRW, LE, LETF, LGAMMA, LH, LHMAX, LHOLD,
+     *   LMXSTP, LIPVT,
      *   LJCALC, LK, LKOLD, LIWM, LML, LMTYPE, LMU, LMXORD, LNJE, LNPD,
      *   LNRE, LNS, LNST, LNSTL, LPD, LPHASE, LPHI, LPSI, LROUND, LS,
      *   LSIGMA, LTN, LTSTOP, LWM, LWT, MBAND, MSAVE, MXORD, NPD, NTEMP,
@@ -958,8 +959,8 @@
 C
 C     SET POINTERS INTO IWORK
       PARAMETER (LML=1, LMU=2, LMXORD=3, LMTYPE=4, LNST=11,
-     *  LNRE=12, LNJE=13, LETF=14, LCTF=15, LNPD=16,
-     *  LIPVT=21, LJCALC=5, LPHASE=6, LK=7, LKOLD=8,
+     *  LNRE=12, LNJE=13, LETF=14, LCTF=15, LNPD=16, LMXSTP=21,
+     *  LIPVT=22, LJCALC=5, LPHASE=6, LK=7, LKOLD=8,
      *  LNS=9, LNSTL=10, LIWM=1)
 C
 C     SET RELATIVE OFFSET INTO RWORK
@@ -1016,7 +1017,7 @@
          LENRW=40+(IWORK(LMXORD)+4)*NEQ+LENPD
 C
 C     CHECK LENGTHS OF RWORK AND IWORK
-60    LENIW=20+NEQ
+60    LENIW=21+NEQ
       IWORK(LNPD)=LENPD
       IF(LRW.LT.LENRW)GO TO 704
       IF(LIW.LT.LENIW)GO TO 705
@@ -1030,6 +1031,13 @@
          IF(HMAX.LE.0.0D0)GO TO 710
 70    CONTINUE
 C
+C     CHECK AND COMPUTE MAXIMUM STEPS
+      MXSTP=500
+      IF(INFO(12).EQ.0)GO TO 80
+        MXSTP=IWORK(LMXSTP)
+        IF(MXSTP.LT.0)GO TO 716
+80      IWORK(LMXSTP)=MXSTP
+C
 C     INITIALIZE COUNTERS
       IWORK(LNST)=0
       IWORK(LNRE)=0
@@ -1268,7 +1276,7 @@
       IF (IDID .EQ. -12) GO TO 527
 C
 C     CHECK FOR TOO MANY STEPS
-      IF((IWORK(LNST)-IWORK(LNSTL)).LT.500)
+      IF((IWORK(LNST)-IWORK(LNSTL)).LT.IWORK(LMXSTP))
      *   GO TO 510
            IDID=-1
            GO TO 527
@@ -1574,6 +1582,11 @@
      *   15, 1)
       GO TO 750
 C
+716   WRITE (XERN1, '(I8)') MXSTP
+      CALL XERMSG ('SLATEC', 'DDASSL',
+     *   'INFO(12)=1 AND MXSTP = ' // XERN1 // ' ILLEGAL.', 3, 1)
+      GO TO 750
+C
 717   WRITE (XERN1, '(I8)') IWORK(LML)
       CALL XERMSG ('SLATEC', 'DDASSL',
      *   'ML = ' // XERN1 // ' ILLEGAL.  EITHER .LT. 0 OR .GT. NEQ',
--- a/libcruft/misc/quit.cc	Mon Jun 16 19:09:11 2003 +0000
+++ b/libcruft/misc/quit.cc	Tue Jun 17 04:36:08 2003 +0000
@@ -37,6 +37,9 @@
 
 octave_jmp_buf current_context;
 
+void (*octave_interrupt_hook) (void) = 0;
+void (*octave_bad_alloc_hook) (void) = 0;
+
 void
 octave_save_current_context (void *save_buf)
 {
@@ -96,12 +99,18 @@
 void
 octave_throw_interrupt_exception (void)
 {
+  if (octave_interrupt_hook)
+    octave_interrupt_hook ();
+    
   throw octave_interrupt_exception ();
 }
 
 void
 octave_throw_bad_alloc (void)
 {
+  if (octave_bad_alloc_hook)
+    octave_bad_alloc_hook ();
+    
   throw std::bad_alloc ();
 }
 
--- a/libcruft/misc/quit.h	Mon Jun 16 19:09:11 2003 +0000
+++ b/libcruft/misc/quit.h	Tue Jun 17 04:36:08 2003 +0000
@@ -87,6 +87,9 @@
     } \
   while (0)
 
+extern void (*octave_interrupt_hook) (void);
+extern void (*octave_bad_alloc_hook) (void);
+
 /* Normally, you just want to use
 
      BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE;
--- a/liboctave/ChangeLog	Mon Jun 16 19:09:11 2003 +0000
+++ b/liboctave/ChangeLog	Tue Jun 17 04:36:08 2003 +0000
@@ -1,3 +1,13 @@
+2003-06-16  John W. Eaton  <jwe@bevo.che.wisc.edu>
+
+	* DASSL.cc (DASSL::do_integrate): Set liw to 21 + n, not 20 + n.
+	Handle step limit.
+	* DASSL-opts.in: New option for step limit.
+
+2003-06-16  Per Persson <persquare@mac.com>
+
+	* oct-shlib.cc: Include mach-o/dyld.h, not Mach-O/dyld.h.
+
 2003-06-16  John W. Eaton  <jwe@bevo.che.wisc.edu>
 
 	* DASRT.cc (DASRT::integrate): Set liw to 21 + n, not 20 + n.
--- a/liboctave/DASSL-opts.in	Mon Jun 16 19:09:11 2003 +0000
+++ b/liboctave/DASSL-opts.in	Tue Jun 17 04:36:08 2003 +0000
@@ -120,3 +120,14 @@
   INIT_VALUE = "-1.0"
   SET_EXPR = "(val >= 0.0) ? val : -1.0"
 END_OPTION
+
+OPTION
+  NAME = "step limit"
+  DOC_ITEM
+Maximum number of integration steps to attempt on a single call to the
+underlying Fortran code.
+  END_DOC_ITEM
+  TYPE = "int"
+  INIT_VALUE = "-1"
+  SET_EXPR = "(val >= 0) ? val : -1"
+END_OPTION
--- a/liboctave/DASSL.cc	Mon Jun 16 19:09:11 2003 +0000
+++ b/liboctave/DASSL.cc	Tue Jun 17 04:36:08 2003 +0000
@@ -140,7 +140,7 @@
 
       int n = size ();
 
-      liw = 20 + n;
+      liw = 21 + n;
       lrw = 40 + 9*n + n*n;
 
       nn = n;
@@ -219,6 +219,14 @@
       else
 	info(7) = 0;
 
+      if (step_limit () >= 0)
+	{
+	  info(11) = 1;
+	  iwork(20) = step_limit ();
+	}
+      else
+	info(11) = 0;
+
       int maxord = maximum_order ();
       if (maxord >= 0)
 	{
--- a/liboctave/oct-shlib.cc	Mon Jun 16 19:09:11 2003 +0000
+++ b/liboctave/oct-shlib.cc	Tue Jun 17 04:36:08 2003 +0000
@@ -30,7 +30,7 @@
 #endif
 
 #if defined (HAVE_DYLD_API)
-#include <Mach-O/dyld.h>
+#include <mach-o/dyld.h>
 #endif
 
 extern "C"
--- a/src/ChangeLog	Mon Jun 16 19:09:11 2003 +0000
+++ b/src/ChangeLog	Tue Jun 17 04:36:08 2003 +0000
@@ -1,3 +1,15 @@
+2003-06-16  John W. Eaton  <jwe@bevo.che.wisc.edu>
+
+	* toplev.cc (main_loop): Set octave_interrupt_hook and
+	octave_bad_alloc_hook to unwind_protect::run_all here.
+	(recover_from_exception): Don't call unwind_protect::run_all here.
+
+	* pt-except.cc (do_catch_code): Return immediately if
+	octave_interrupt_immediately is nonzero.
+
+	* sighandlers.cc (sigint_handler): If jumping, don't set
+	octave_interrupt_state.
+
 2003-06-14  John W. Eaton  <jwe@bevo.che.wisc.edu>
 
 	* load-save.cc (get_save_type): Avoid all save types other than
--- a/src/pt-except.cc	Mon Jun 16 19:09:11 2003 +0000
+++ b/src/pt-except.cc	Tue Jun 17 04:36:08 2003 +0000
@@ -28,6 +28,8 @@
 #include <config.h>
 #endif
 
+#include "quit.h"
+
 #include "error.h"
 #include "oct-lvalue.h"
 #include "ov.h"
@@ -55,6 +57,9 @@
 static void
 do_catch_code (void *ptr)
 {
+  if (octave_interrupt_immediately)
+    return;
+
   tree_statement_list *list = static_cast<tree_statement_list *> (ptr);
 
   unwind_protect::begin_frame ("do_catch_code");
--- a/src/sighandlers.cc	Mon Jun 16 19:09:11 2003 +0000
+++ b/src/sighandlers.cc	Tue Jun 17 04:36:08 2003 +0000
@@ -285,10 +285,10 @@
 	    octave_debug_on_interrupt_state = false;
 	}
 
-      octave_interrupt_state = 1;
-
       if (octave_interrupt_immediately)
 	octave_jump_to_enclosing_context ();
+      else
+	octave_interrupt_state = 1;
     }
 
   SIGHANDLER_RETURN (0);
--- a/src/toplev.cc	Mon Jun 16 19:09:11 2003 +0000
+++ b/src/toplev.cc	Tue Jun 17 04:36:08 2003 +0000
@@ -98,7 +98,6 @@
 static void
 recover_from_exception (void)
 {
-  unwind_protect::run_all ();
   can_interrupt = true;
   octave_interrupt_immediately = 0;
   octave_interrupt_state = 0;
@@ -126,6 +125,9 @@
 
   can_interrupt = true;
 
+  octave_interrupt_hook = unwind_protect::run_all;
+  octave_bad_alloc_hook = unwind_protect::run_all;
+
   octave_catch_interrupts ();
 
   octave_initialized = true;