Blob Blame Raw
Description: <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
Author: Camm Maguire <camm@debian.org>

---
The information above should follow the Patch Tagging Guidelines, please
checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:

Origin: <vendor|upstream|other>, <url of original patch>
Bug: <url in upstream bugtracker>
Bug-Debian: https://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
Forwarded: <no|not-needed|url proving that it has been forwarded>
Reviewed-By: <name and email of someone who approved the patch>
Last-Update: 2016-09-23

--- gcl-2.6.12.orig/h/unrandomize.h
+++ gcl-2.6.12/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++)
--- gcl-2.6.12.orig/lsp/gcl_serror.lsp
+++ gcl-2.6.12/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))
+(defun dbl-rpl-loop (p-e-p)
 
-  (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))))
+  (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)
--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp
+++ gcl-2.6.12/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))
--- gcl-2.6.12.orig/o/main.c
+++ gcl-2.6.12/o/main.c
@@ -464,19 +464,12 @@ DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",o
 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