From: <don...@is...> - 2018-09-20 22:23:01
|
I've lucked into an easily reproducible example! This is in MT clisp newly built from source in fedora 24. More details are available if they'll help. I look forward to hearing about the diagnosis and cure from the MT experts. in shell: ./lisp.run -M ./lispinit.mem (load ".../plain-dbg-server.lisp") (now it's waiting at command line with prompt [2]>) Here's the source for plain-dbg-server: ==== #-(and clisp MT)(error "this file needs MT") (setf *debug-server-port* 8225) (push :usemp *features*) (defun serve-one-debugger(socket) (let ((tlist (loop for x in (mt:list-threads) with i = 0 when (mt:thread-active-p x) collect (cons (incf i) x))) ans) (print tlist socket) (format socket "~&enter the number of a thread to interrupt/debug: ") (setf ans (or (cdr (assoc (read socket) tlist)) ;; try to put in package ap5? (mt:current-thread))) (mt:thread-interrupt ans :function (lambda nil (let ((*standard-input* socket) (*standard-output* socket) (*debug-io* socket) (*error-output* socket) (*trace-output* socket) (*query-io* socket)) (unwind-protect (break "debug") ;; close socket when finished with break (close socket))))))) (defun show-ut (&optional (ut (get-universal-time))) (multiple-value-bind (s m h d mo y) (decode-universal-time ut) (format nil "~d-~d-~d ~2,'0d:~2,'0d:~2,'0d" y mo d h m s))) (defun new-debugger-name() (format nil "debugger-~a" (show-ut))) (defun debug-server() (let ((server (socket:socket-server *debug-server-port* :interface "localhost"))) (unwind-protect (loop (let ((socket (socket:socket-accept server :buffered nil))) (mt:make-thread #'(lambda ()(serve-one-debugger socket)) :name (new-debugger-name)))) (socket:socket-server-close server)))) (mt:make-thread #'debug-server :name "debug-server") ==== Now in another shell: telnet localhost 8225 Trying ::1... telnet: connect to address ::1: Connection refused Trying 127.0.0.1... Connected to localhost. Escape character is '^]'. ((1 . #<THREAD "debugger-2018-9-20 14:34:32">) (2 . #<THREAD "debug-server">) (3 . #<THREAD "main thread">)) enter the number of a thread to interrupt/debug: 1 1 [the date naming the first thread will be different, but type 1] ** - Continuable Error debug If you continue (by typing 'continue'): Return from BREAK loop The following restarts are also available: ABORT :R1 ABORT Break 1 [1]> Now from the break I do this defun and it segfaults. I know this code is gibberish. I was trying to remove junk that didn't affect whether it crashes, and might have gone further on that path, but was eager to send this when I discovered that all I needed to cause the crash was the debug server. (defun andgenerator (vars wff gen) (and gen `( (initialstate ,(unless *in-relationsize* `(let (,.(setq statevars (loop for g in gens unless (assoc 'test (genprops g)) collect (gensym "ST"))) (start-flg t) ,@(when saved '(saved-tables))) ,@(when saved '(saved-tabl\ es)) #'(lambda nil (prog , (setq bind (list '|Exhausted |)) (cond (start-flg (setq start-flg nil) (go start)) (t (go cont))) GEN0CONT (return t) ;exhausted start ,@(let (ans check gen1 wff1) (loop for g on gens do (cond ((not (assoc 'test (genprops (car g)))) (setq gen1 (sgen (car g)) wff1 (wff (car g))) (setq check nil) (push `(multiple-value-setq (|Exhausted | ,@(cond ((compoundwffp wff1) (loop for var in (cadr (assoc 'output gen1)) collect nil)) (t (loop for var in (cdr wff1) as pos from 0 as temp in (cadr (assoc 'template gen1)) when (eq temp 'output) collect (cond ((variable-p var) (push (list (make-evalvar :evalvarname (gensym "CHK") :evalvarcompare (varcompare var)) (name-of-var var)) check) (nconc bind (list (evalvarname (caar check)))) (evalvarname (caar check)))))))) (funcall ,(pop statevars))) ans) (setq remainingvars (fldifference remainingvars (soutput (car g))))) (t (push `(cond ((?? ,.(vars&rels-to-names-wff (wff (car g)))) nil) (t (go ,(pack* 'gen label 'cont)))) ans)))) (reverse ans)) (return (values nil ,@(vars-to-names (soutput gen)))))))))))) |