Description: 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 --- 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: , Bug: Bug-Debian: https://bugs.debian.org/ Bug-Ubuntu: https://launchpad.net/bugs/ Forwarded: Reviewed-By: 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 -#include -#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 +#include +#include "unrandomize.h" +#endif + + gcl_init_alloc(&argv); + setbuf(stdin, stdin_buf); setbuf(stdout, stdout_buf); #ifdef _WIN32