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