# HG changeset patch # User jwe # Date 1055824568 0 # Node ID c1f6200b5f0ea055b83ff73243a1754a9a11d00d # Parent 067160691cc9fffe555f51f245b1662824846289 [project @ 2003-06-17 04:36:08 by jwe] diff --git a/libcruft/ChangeLog b/libcruft/ChangeLog --- a/libcruft/ChangeLog +++ b/libcruft/ChangeLog @@ -1,5 +1,20 @@ 2003-06-16 John W. Eaton + * 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. diff --git a/libcruft/dasrt/ddasrt.f b/libcruft/dasrt/ddasrt.f --- a/libcruft/dasrt/ddasrt.f +++ b/libcruft/dasrt/ddasrt.f @@ -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 diff --git a/libcruft/dassl/ddajac.f b/libcruft/dassl/ddajac.f --- a/libcruft/dassl/ddajac.f +++ b/libcruft/dassl/ddajac.f @@ -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 diff --git a/libcruft/dassl/ddaslv.f b/libcruft/dassl/ddaslv.f --- a/libcruft/dassl/ddaslv.f +++ b/libcruft/dassl/ddaslv.f @@ -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) diff --git a/libcruft/dassl/ddassl.f b/libcruft/dassl/ddassl.f --- a/libcruft/dassl/ddassl.f +++ b/libcruft/dassl/ddassl.f @@ -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', diff --git a/libcruft/misc/quit.cc b/libcruft/misc/quit.cc --- a/libcruft/misc/quit.cc +++ b/libcruft/misc/quit.cc @@ -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 (); } diff --git a/libcruft/misc/quit.h b/libcruft/misc/quit.h --- a/libcruft/misc/quit.h +++ b/libcruft/misc/quit.h @@ -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; diff --git a/liboctave/ChangeLog b/liboctave/ChangeLog --- a/liboctave/ChangeLog +++ b/liboctave/ChangeLog @@ -1,3 +1,13 @@ +2003-06-16 John W. Eaton + + * 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 + + * oct-shlib.cc: Include mach-o/dyld.h, not Mach-O/dyld.h. + 2003-06-16 John W. Eaton * DASRT.cc (DASRT::integrate): Set liw to 21 + n, not 20 + n. diff --git a/liboctave/DASSL-opts.in b/liboctave/DASSL-opts.in --- a/liboctave/DASSL-opts.in +++ b/liboctave/DASSL-opts.in @@ -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 diff --git a/liboctave/DASSL.cc b/liboctave/DASSL.cc --- a/liboctave/DASSL.cc +++ b/liboctave/DASSL.cc @@ -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) { diff --git a/liboctave/oct-shlib.cc b/liboctave/oct-shlib.cc --- a/liboctave/oct-shlib.cc +++ b/liboctave/oct-shlib.cc @@ -30,7 +30,7 @@ #endif #if defined (HAVE_DYLD_API) -#include +#include #endif extern "C" diff --git a/src/ChangeLog b/src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,15 @@ +2003-06-16 John W. Eaton + + * 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 * load-save.cc (get_save_type): Avoid all save types other than diff --git a/src/pt-except.cc b/src/pt-except.cc --- a/src/pt-except.cc +++ b/src/pt-except.cc @@ -28,6 +28,8 @@ #include #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 (ptr); unwind_protect::begin_frame ("do_catch_code"); diff --git a/src/sighandlers.cc b/src/sighandlers.cc --- a/src/sighandlers.cc +++ b/src/sighandlers.cc @@ -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); diff --git a/src/toplev.cc b/src/toplev.cc --- a/src/toplev.cc +++ b/src/toplev.cc @@ -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;