<short summary of the patch>

TODO: Put a short summary on the line above and replace this paragraph
with a longer explanation of this change. Complete the meta-information
with other relevant fields (see below for details). To make it easier, the
information below has been extracted from the changelog. Adjust it or drop
it.

gcl (2.6.12-34) unstable; urgency=medium

  * Version_2_6_13pre45

Gbp-Pq: Name Version_2_6_13pre45

diff --git a/h/unrandomize.h b/h/unrandomize.h
index 1d915a0d9ffb1a21c6cdad05508e71c844ef4111..74cc659f44d9c04b97606b809c5201e93411348f 100644 (file)
--- a/h/unrandomize.h
+++ b/h/unrandomize.h
@@ -23,7 +23,6 @@
        int i,j,k;
        char **n,**a;
        void *v;
-       argv[0]="/proc/self/exe";
        for (i=j=0;argv[i];i++)
          j+=strlen(argv[i])+1;
        for (k=0;envp[k];k++)

diff --git a/lsp/gcl_serror.lsp b/lsp/gcl_serror.lsp
index 5c110a8afaa4481bae4d4c6bd36eb907c39b1b68..df4ceda4ba0a08a018e5068adafdb87785e69b9e 100755 (executable)
--- a/lsp/gcl_serror.lsp
+++ b/lsp/gcl_serror.lsp
@@ -174,7 +174,7 @@
       (format *error-output* "~&If continued: ")
       (funcall (restart-report-function correctable) *error-output*))
     (force-output *error-output*)
-    (break-level condition)))
+    (when *break-enable* (break-level condition))))
 
 
 (defun dbl-eval (- &aux (break-command t))
@@ -186,54 +186,51 @@
                    (t (setq break-command nil) (evalhook - nil nil *break-env*))))))
     (cons break-command val-list)))
 
-(defun do-break-level (at env p-e-p debug-level break-level &aux (first t))
-
-  (do nil (nil) 
-   
-   (unless
-       (with-simple-restart 
-       (abort "Return to debug level ~D." debug-level)
-       (not
-        (catch 'step-continue
-          (let* ((*break-level* break-level)
-                 (*break-enable* (unless p-e-p *break-enable*))
-                 (*readtable* (or *break-readtable* *readtable*))
-                 *break-env* *read-suppress*); *error-stack*)
-
-            (setq +++ ++ ++ + + -)
-
-            (when first
-              (catch-fatal 1)
-              (setq *interrupt-enable* t first nil)
-              (cond (p-e-p 
-                     (format *debug-io* "~&~A~2%" at)
-                     (set-current)
-                     (setq *no-prompt* nil)
-                     (show-restarts))
-                    ((set-back at env))))
-
-            (if *no-prompt* 
-                (setq *no-prompt* nil)
-              (format *debug-io* "~&~a~a>~{~*>~}"
-                      (if p-e-p "" "dbl:")
-                      (if (eq *package* (find-package 'user)) "" (package-name *package*))
-                      break-level))
-            (force-output *error-output*)
-
-            (setq - (dbl-read *debug-io* nil *top-eof*))
-            (when (eq - *top-eof*) (bye -1))
-            (let* ((ev (dbl-eval -))
-                   (break-command (car ev))
-                   (values (cdr ev)))
-              (and break-command (eq (car values) :resume)(return))
-              (setq /// // // / / values *** ** ** * * (car /))
-              (fresh-line *debug-io*)
-              (dolist (val /)
-                (prin1 val *debug-io*)
-                (terpri *debug-io*)))
-            nil))))
-     (terpri *debug-io*)
-     (break-current))))
+(defun dbl-rpl-loop (p-e-p)
+
+  (setq +++ ++ ++ + + -)
+
+  (if *no-prompt*
+      (setq *no-prompt* nil)
+    (format *debug-io* "~&~a~a>~{~*>~}"
+           (if p-e-p "" "dbl:")
+           (if (eq *package* (find-package 'user)) "" (package-name *package*))
+           *break-level*))
+  (force-output *error-output*)
+
+  (setq - (dbl-read *debug-io* nil *top-eof*))
+  (when (eq - *top-eof*) (bye -1))
+  (let* ((ev (dbl-eval -))
+        (break-command (car ev))
+        (values (cdr ev)))
+    (unless (and break-command (eq (car values) :resume))
+      (setq /// // // / / values *** ** ** * * (car /))
+      (fresh-line *debug-io*)
+      (dolist (val /)
+       (prin1 val *debug-io*)
+       (terpri *debug-io*))
+      (dbl-rpl-loop p-e-p))))
+
+(defun do-break-level (at env p-e-p debug-level); break-level
+
+  (unless
+      (with-simple-restart
+       (abort "Return to debug level ~D." debug-level)
+
+       (catch-fatal 1)
+       (setq *interrupt-enable* t)
+       (cond (p-e-p
+             (format *debug-io* "~&~A~2%" at)
+             (set-current)
+             (setq *no-prompt* nil)
+             (show-restarts))
+            ((set-back at env)))
+
+       (not (catch 'step-continue (dbl-rpl-loop p-e-p))))
+
+    (terpri *debug-io*)
+    (break-current)
+    (do-break-level at env p-e-p debug-level)))
 
 
 (defun break-level (at &optional env)
@@ -242,10 +239,10 @@
          (- -)
          (* *) (** **) (*** ***)
          (/ /) (// //) (/// ///)
-        (break-level (if p-e-p (cons t *break-level*) *break-level*))
         (debug-level *debug-level*)
         (*quit-tags* (cons (cons *break-level* *quit-tag*) *quit-tags*))
         *quit-tag*
+        (*break-level* (if p-e-p (cons t *break-level*) *break-level*))
         (*ihs-base* (1+ *ihs-top*))
         (*ihs-top* (ihs-top))
         (*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top))))
@@ -255,9 +252,11 @@
         (*debug-restarts* (compute-restarts))
         (*debug-abort* (find-restart 'abort))
         (*debug-continue* (find-restart 'continue))
-        (*abort-restarts* (remove-if-not (lambda (x) (eq 'abort (restart-name x))) *debug-restarts*)))
+        (*abort-restarts* (remove-if-not (lambda (x) (eq 'abort (restart-name x))) *debug-restarts*))
+        (*readtable* (or *break-readtable* *readtable*))
+        *break-env* *read-suppress*)
     
-      (do-break-level at env p-e-p debug-level break-level)))
+      (do-break-level at env p-e-p debug-level)))
 
 (putprop 'break-level t 'compiler::cmp-notinline)
 
@@ -278,6 +277,6 @@
             (setq message ""))))
   (with-simple-restart 
    (continue "Return from break.")
-   (let ((*break-enable* t)) (break-level message)))
+   (break-level message))
   nil)
 (putprop 'break t 'compiler::cmp-notinline)

diff --git a/lsp/sys-proclaim.lisp b/lsp/sys-proclaim.lisp
index 208f94ba2cd701dfd78b3158afdd9d7f7dba302b..3c0931a875c8309224389db0607ba2c09c719655 100755 (executable)
--- a/lsp/sys-proclaim.lisp
+++ b/lsp/sys-proclaim.lisp
@@ -4,7 +4,7 @@
     '(COMMON-LISP::FTYPE
          (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
          ANSI-LOOP::LOOP-EMIT-FINAL-VALUE SYSTEM::INSPECT-CHARACTER
-         SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS
+         SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS SYSTEM::DBL-RPL-LOOP
          SYSTEM::RESTART-FUNCTION COMMON-LISP::TANH COMMON-LISP::FIFTH
          SLOOP::PARSE-LOOP-INITIALLY SYSTEM::NEXT-STACK-FRAME
          SYSTEM::IDESCRIBE SYSTEM::PROCESS-ARGS SYSTEM::LEAP-YEAR-P
@@ -268,7 +268,7 @@
              (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
                  COMMON-LISP::T)
              COMMON-LISP::T)
-         SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION
+         SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION SYSTEM::DO-BREAK-LEVEL
          SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC
          SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS
          SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN)) 
@@ -334,7 +334,7 @@
              (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
                  COMMON-LISP::T COMMON-LISP::T)
              COMMON-LISP::T)
-         SYSTEM::MAKE-PREDICATE SYSTEM::DO-BREAK-LEVEL
+         SYSTEM::MAKE-PREDICATE
          SYSTEM::MAKE-CONSTRUCTOR)) 
 (COMMON-LISP::PROCLAIM
     '(COMMON-LISP::FTYPE
@@ -519,4 +519,4 @@
          (COMMON-LISP::FUNCTION
              (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM)
              COMMON-LISP::FIXNUM)
-         SYSTEM::ROUND-UP)) 
\ No newline at end of file
+         SYSTEM::ROUND-UP))

diff --git a/o/main.c b/o/main.c
index 8c3d37cd536f35117c73aec180349a242ad2c665..ff0ba3f82a75e684ab4c392c24fadc91b7a3b8bd 100755 (executable)
--- a/o/main.c
+++ b/o/main.c
@@ -464,19 +464,12 @@ DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",object,fSequal_tail_recursion_check,SI,1,
 int
 main(int argc, char **argv, char **envp) {
 
-#ifdef CAN_UNRANDOMIZE_SBRK
-#include <stdio.h>
-#include <stdlib.h>
-#include "unrandomize.h"
-#endif
-
-  gcl_init_alloc(&argv);
-
 #ifdef GET_FULL_PATH_SELF
   GET_FULL_PATH_SELF(kcl_self);
 #else
   kcl_self = argv[0];
 #endif
+
 #ifdef __MINGW32__
   {
     char *s=kcl_self;
@@ -485,6 +478,14 @@ main(int argc, char **argv, char **envp) {
 #endif 
   *argv=kcl_self;
   
+#ifdef CAN_UNRANDOMIZE_SBRK
+#include <stdio.h>
+#include <stdlib.h>
+#include "unrandomize.h"
+#endif
+
+  gcl_init_alloc(&argv);
+
   setbuf(stdin, stdin_buf); 
   setbuf(stdout, stdout_buf);
 #ifdef _WIN32