McCLIM / McCLIM

An implementation of the Common Lisp Interface Manager, version II
Other
579 stars 117 forks source link

Xserver connection crashes #55

Open gabriel-laddel opened 8 years ago

gabriel-laddel commented 8 years ago

The two errors error below prevents one from programming entirely in McCLIM, which is one of the more important milestones in the progression of this project from "moribund open-source" (not my description - private correspondence) to "humanity's most sane graphics library". While it's possible that you just wandered into this conversation, it's more likely that you find yourself here because you know that lisp in general + CL in the particular makes you a more productive programmer and quashes many classes of errors that plauge the so-called high tech industry. The case for programming entirely in CL (via CLIM-LISTENER, CLOUSEAU & CLIMACS) is this: you can forget all of the irrelevent, incidental complexity that has nothing whatsover to do with your problem, and thereby effectively augment your own intelligence. IMHO, most useful programming is done while in a state of flow. Unless we can hack on CLIM within its own paradgim the benefits of working in a single language are lost, and the project will continue to languish on the sidelines as "neat". That being said, I'll solve these myself eventually if no one else does. McCLIM is too neat to leave be.

One clear example of an useful optimization that CLIM allows for that would be a PITA in another language, including elisp (no reader macros, packages, no threads/ multiprocessing, slow, incomplete mapping between the two languages, passing data back and forth, unable to clearly call from one to the other..)

#| OBJECT GRAPH TRAVERSALS

While at the inspector or the like you should be able to ask it to 'walk slots of' an arbitrary
object to an arbitrary depth, returning paths to all objects matching a predicate, and 
abstracting over the whole WRITER/READER/SLOT-VALUE nonsense. Give me a sexpr
I can SETF. The notion that one should have to M-. around  a class heigharchy, consulting
docs etc to find a path from buffer to view or w/e is insane.

----------------------------------------

This must be evaluated inside of climacs.  Then eval climi::traversal-results at the listener
to observe the resultant structure one will eventually turn into a spiffy GUI display. The
idea is that you will click on a 'path' and it shall be inserted into the editor at point.

The implemention will be a keystroke that calls INSERT-SEQUENCE and quits the GUI, 
spitting out all selected paths using (format nil "~{~%~S~}" paths). Running in
another thread means that you can jump around and do whatever in the editor 
without losing your place.. example code:

(let* ((point (climacs-gui::point)))
  (bt:make-thread (lambda () 
                           ; GUI here.
                           (flexichain:insert-sequence point "lel")) 
                  :name "inspector"))
|#

(in-package climi)

(use-package 'cl-ppcre)

(defun class-slots (o)
  (mapcar 'sb-mop::slot-definition-name
          (sb-mop:class-slots (typecase o
                                (symbol (find-class o))
                                (t (find-class (type-of o)))))))

(defun apropos-class-slots (regex o)
  (remove-if-not (lambda (o) (or (scan regex (symbol-name o))
                                 (scan (string-downcase regex) (string-downcase (symbol-name o)))))
                 (class-slots o)))

(defun object-slot-kvs (o)
  "XXX: Returns list of (SLOT VALUE) from object. If the slot is not bound, 
(SLOT NIL) - BEWARE THESE SEMANTICS"
  (loop with slot-names = (class-slots o)
        for name in slot-names
        collect (list name (when (slot-boundp o name) (slot-value o name)))))

(defun object-slot-kvs-matching (predicate-function o &key 
                                 (kv-access-function #'second) 
                                 (kv-return-function #'identity))
  "Filters OBJECT-SLOT-KVS. PREDICATE-FUNCTION accepts a single argument 
returning a generalized boolean. KV-ACCESS-FUNCTION should be CAR or SECOND, 
corresponding to who we call PREDICATE-FUNCTION on. CAR for the slot name, or 
second for the slot's value. KV-RETURN-FUNCTION is used to adjust what is 
returned. Should be CAR, SECOND or the default, IDENTITY for the K V pairing"
  (mapcar kv-return-function 
          (remove-if-not (lambda (l) (funcall predicate-function (funcall kv-access-function l)))
                         (object-slot-kvs o))))

(defun object-slot-names (o)
  (object-slot-kvs-matching #'identity o :kv-return-function 'car))

(defun object-slot-values-matching (predicate-function o)
  "PREDICATE-FUNCTION accepts a single argument, returning a generalized boolean"
  (object-slot-kvs-matching predicate-function o :kv-return-function 'second :kv-access-function 'second))

(defun object-slot-names-matching (predicate-function o)
  "PREDICATE-FUNCTION accepts a single argument, returning a generalized boolean
and is garunteed a SYMBOL as the that argument"
  (object-slot-kvs-matching predicate-function o :kv-return-function 'car :kv-access-function 'car))

(defun scan-object-slot-kvs (search-regex o &key
                             (kv-return-function 'identity) 
                             (kv-access-function 'car))
  ;; TODO, should probably remove the access-function
  "Beware of using SECOND as the KV-ACCESS-FUNCTION, it probably doesnt' make 
sense for whatever it is you're trying to do"
  (mapcar kv-return-function 
          (remove-if-not (lambda (o) (let* ((o (funcall kv-access-function o)))
                                       (cond ((stringp o) (scan search-regex o))
                                             ((symbolp o) (or (scan search-regex (symbol-name o))
                                                              (scan (string-upcase search-regex) (string-upcase (symbol-name o)))
                                                              (scan (string-downcase search-regex) (string-downcase (symbol-name o))))))))
                         (object-slot-kvs o))))

(defun scan-object-slot-names (search-regex o)
  (scan-object-slot-kvs search-regex o :kv-return-function 'car))

(defun scan-object-slot-values (search-regex o)
  "Uses CL-PPCRE:SCAN as a filter on the SYMBOL-NAME of each slot name, 
returning matching values. If you want to scan the string values of slots,
read the source of SCAN-OBJECT-SLOT-KVS"
  (scan-object-slot-kvs search-regex o :kv-return-function 'second))

(defparameter seen-objects ()
  "We test EQuality against each object when searching an object tree, to 
prevent loops

SEEN-OBJECTS must be set to NIL after running PATHS-TO-OBJECT-SLOT-KVS-MATCHING-TO-DEPTH")

(defun paths-to-object-slot-kvs-matching-to-depth
    (predicate-function o search-depth &key (kv-access-function 'second) (slot-path nil))
  "OBJECT-SLOT-KVS-MATCHING that does a search on the object tree, using O as a
starting point to the depth of SEARCH-DEPTH, returning. SLOT-PATH is for internal
use only, and should not 

In the case that the slot is not bound, it is skipped, though really this should
be controllable"
  (unless (zerop search-depth) 
    (let* ((unseen-object-kvs (remove-if (lambda (o) (member o seen-objects :test 'eq))
                                         (object-slot-kvs o) :key 'second))
           (matching-objects (mapcar (lambda (l) (if slot-path (append slot-path l) l))
                                     (remove-if-not predicate-function unseen-object-kvs :key kv-access-function))))
      (setf seen-objects (append seen-objects unseen-object-kvs))
      (remove nil (append matching-objects                          
                          (mapcar (lambda (new-kv) (let* ((new-object (second new-kv))
                                                          (new-slot (car new-kv)))
                                                     (ignore-errors (paths-to-object-slot-kvs-matching-to-depth 
                                                                     predicate-function new-object (1- search-depth)
                                                                     :kv-access-function kv-access-function
                                                                     :slot-path (cons new-slot slot-path)))))
                                  unseen-object-kvs)))))) ;; search depth should default to..?

(setf climi::traversal-results
      (progn (setf seen-objects nil)
             (paths-to-object-slot-kvs-matching-to-depth
              (lambda (o) (let* ((search-regex "view"))
                            (cond ((stringp o) (scan search-regex o))
                                  ((symbolp o) (or (cl-ppcre::scan search-regex (symbol-name o))
                                                   (cl-ppcre::scan (string-upcase search-regex) (string-upcase (symbol-name o)))
                                                   (cl-ppcre::scan (string-downcase search-regex) (string-downcase (symbol-name o))))))))
              (drei::current-window)
              4 :kv-access-function 'car)))

The X-LENGTH error

Screenshot: http://old.sigkill.dk/athas/climdshots/6.png

The X connection dies on the server side, and all CLIM panes stop rendering. Under some very limited circumstances one can use a restart to fix this (https://github.com/robert-strandh/McCLIM/issues/20#issuecomment-200644782). This error is particularly insidious because it means you must restart your machine or the X server, losing all state. It is often encountered when using the CLIM-DEBUGGER, which prints large structures in the frames.

To reproduce: Open up the listener and evaluate (climi::with-text-size (t 1200) (princ "?"))

[Ed note. no clear test cases now that the text size problem has been fixed]

The X server's "max-request-size" parameter does not appear to be the problem.

(in-package xlib) (defparameter proposed-maximum-request-size (WITH-DISPLAY "" (DISPLAY SCREEN _) (DISPLAY-MAX-REQUEST-LENGTH DISPLAY)))

If anyone has a strategy for interrogating the X server about its state, I would like to hear it. All I've got is a pointer to xlibtrace, which won't compile unless you use the patch in this stackoverflow post (in the later comments iirc). http://kev.pulo.com.au/xlibtrace http://stackoverflow.com/questions/2349538/xlib-integrated-debugging-tracing/2350412#2350412

It would be neat to utilize the CL::SIGNAL mechanism to take any 'invalid' output record and instead render (draw-text* stream "the drawing routine passed ~S violates such and such X server oddity") and simply forget about the whole thing until we move to writing directly to framebuffer.

gabriel-laddel commented 8 years ago

I got bored with work and re-wrote the navigtor sans many useful features. Still useful. [this code has been moved https://github.com/robert-strandh/McCLIM/wiki/Navigator]

gas2serra commented 8 years ago

The first problem happens when it tries to add a big glyph (line 117 of xrender-fonts.lisp).

In your example, the array had 736388 elements. I think, in my machine the max request is about 262140 bytes. Too much.

diff --git a/Extensions/fonts/xrender-fonts.lisp b/Extensions/fonts/xrender-fonts.lisp

index ae1a466..ed222e1 100644 --- a/Extensions/fonts/xrender-fonts.lisp +++ b/Extensions/fonts/xrender-fonts.lisp @@ -112,6 +112,11 @@ (setf arr (make-array (list 1 1) :element-type '(unsigned-byte 8) :initial-element 0)))

I reproduce your second problem with the following function:

(defun print-text (s) (dotimes (i 10000) (climi::with-text-size (t 10) (princ s)) (when (= (mod i 80) 0) (format t "~%")) (sleep 0.001)))

Try to lunch (print-text "?") in one listener and (print-text "%") in an another one. Amazing. I think something is not thread safe. Putting a lock around medium-draw-text* seems to work.

I will send you a patch. Let me know....

Alessandro

On 07/24/2016 02:20 AM, Gabriel Laddel wrote:

The two errors below prevent one from programming entirely in McCLIM, which is one of the more important milestones in the progression of this project from "moribund open-source" (not my description - private correspondence) to "humanity's most sane graphics library". While it's possible that you just wandered into this conversation, it's more likely that you find yourself here because you know that lisp in general + CL in the particular makes you a more productive programmer and quashes many classes of errors that plauge the so-called high tech industry. The case for programming /entirely/ in CL (via CLIM-LISTENER, CLOUSEAU & CLIMACS) is this: you can forget all of the irrelevent, incidental complexity that has nothing whatsover to do with your problem, and thereby effectively augment your own intelligence. IMHO, most useful programming is done while in a state of flow. Unless we can hack on CLIM within its own paradgim the benefits of working in a single language are lost, and the project will continue to languish on the sidelines as "neat". That being said, I'll solve these myself eventually if no one else does. McCLIM is too neat to leave be.

One clear example of an useful optimization that CLIM allows for that would be a PITA in another language, including elisp (no reader macros, packages, no threads/ multiprocessing, slow, incomplete mapping between the two languages, passing data back and forth, unable to clearly call from one to the other..)

|#| OBJECT GRAPH TRAVERSALS While at the inspector or the like you should be able to ask it to 'walk slots of' an arbitrary object to an arbitrary depth, returning paths to all objects matching a predicate, and abstracting over the whole WRITER/READER/SLOT-VALUE nonsense. Give me a sexpr I can SETF. The notion that one should have to M-. around a class heigharchy, consulting docs etc to find a path from buffer to view or w/e is insane. ---------------------------------------- This must be evaluated inside of climacs. Then eval climi::traversal-results at the listener to observe the resultant structure one will eventually turn into a spiffy GUI display. The idea is that you will click on a 'path' and it shall be inserted into the editor at point. The implemention will be a keystroke that calls INSERT-SEQUENCE and quits the GUI, spitting out all selected paths using (format nil "~{~%~S~}" paths). Running in another thread means that you can jump around and do whatever in the editor without losing your place.. example code: (let* ((point (climacs-gui::point))) (bt:make-thread (lambda () ; GUI here. (flexichain:insert-sequence point "lel")) :name "inspector")) |# (in-package climi) (use-package 'cl-ppcre) (defun class-slots (o) (mapcar 'sb-mop::slot-definition-name (sb-mop:class-slots (typecase o (symbol (find-class o)) (t (find-class (type-of o))))))) (defun apropos-class-slots (regex o) (remove-if-not (lambda (o) (or (scan regex (symbol-name o)) (scan (string-downcase regex) (string-downcase (symbol-name o))))) (class-slots o))) (defun object-slot-kvs (o) "XXX: Returns list of (SLOT VALUE) from object. If the slot is not bound, (SLOT NIL) - BEWARE THESE SEMANTICS" (loop with slot-names = (class-slots o) for name in slot-names collect (list name (when (slot-boundp o name) (slot-value o name))))) (defun object-slot-kvs-matching (predicate-function o &key (kv-access-function #'second) (kv-return-function #'identity)) "Filters OBJECT-SLOT-KVS. PREDICATE-FUNCTION accepts a single argument returning a generalized boolean. KV-ACCESS-FUNCTION should be CAR or SECOND, corresponding to who we call PREDICATE-FUNCTION on. CAR for the slot name, or second for the slot's value. KV-RETURN-FUNCTION is used to adjust what is returned. Should be CAR, SECOND or the default, IDENTITY for the K V pairing" (mapcar kv-return-function (remove-if-not (lambda (l) (funcall predicate-function (funcall kv-access-function l))) (object-slot-kvs o)))) (defun object-slot-names (o) (object-slot-kvs-matching #'identity o :kv-return-function 'car)) (defun object-slot-values-matching (predicate-function o) "PREDICATE-FUNCTION accepts a single argument, returning a generalized boolean" (object-slot-kvs-matching predicate-function o :kv-return-function 'second :kv-access-function 'second)) (defun object-slot-names-matching (predicate-function o) "PREDICATE-FUNCTION accepts a single argument, returning a generalized boolean and is garunteed a SYMBOL as the that argument" (object-slot-kvs-matching predicate-function o :kv-return-function 'car :kv-access-function 'car)) (defun scan-object-slot-kvs (search-regex o &key (kv-return-function 'identity) (kv-access-function 'car)) ;; TODO, should probably remove the access-function "Beware of using SECOND as the KV-ACCESS-FUNCTION, it probably doesnt' make sense for whatever it is you're trying to do" (mapcar kv-return-function (remove-if-not (lambda (o) (let* ((o (funcall kv-access-function o))) (cond ((stringp o) (scan search-regex o)) ((symbolp o) (or (scan search-regex (symbol-name o)) (scan (string-upcase search-regex) (string-upcase (symbol-name o))) (scan (string-downcase search-regex) (string-downcase (symbol-name o)))))))) (object-slot-kvs o)))) (defun scan-object-slot-names (search-regex o) (scan-object-slot-kvs search-regex o :kv-return-function 'car)) (defun scan-object-slot-values (search-regex o) "Uses CL-PPCRE:SCAN as a filter on the SYMBOL-NAME of each slot name, returning matching values. If you want to scan the string values of slots, read the source of SCAN-OBJECT-SLOT-KVS" (scan-object-slot-kvs search-regex o :kv-return-function 'second)) (defparameter seen-objects () "We test EQuality against each object when searching an object tree, to prevent loops SEEN-OBJECTS must be set to NIL after running PATHS-TO-OBJECT-SLOT-KVS-MATCHING-TO-DEPTH") (defun paths-to-object-slot-kvs-matching-to-depth (predicate-function o search-depth &key (kv-access-function 'second) (slot-path nil)) "OBJECT-SLOT-KVS-MATCHING that does a search on the object tree, using O as a starting point to the depth of SEARCH-DEPTH, returning. SLOT-PATH is for internal use only, and should not In the case that the slot is not bound, it is skipped, though really this should be controllable" (unless (zerop search-depth) (let* ((unseen-object-kvs (remove-if (lambda (o) (member o seen-objects :test 'eq)) (object-slot-kvs o) :key 'second)) (matching-objects (mapcar (lambda (l) (if slot-path (append slot-path l) l)) (remove-if-not predicate-function unseen-object-kvs :key kv-access-function)))) (setf seen-objects (append seen-objects unseen-object-kvs)) (remove nil (append matching-objects (mapcar (lambda (new-kv) (let* ((new-object (second new-kv)) (new-slot (car new-kv))) (ignore-errors (paths-to-object-slot-kvs-matching-to-depth predicate-function new-object (1- search-depth) :kv-access-function kv-access-function :slot-path (cons new-slot slot-path))))) unseen-object-kvs)))))) ;; search depth should default to..? (setf climi::traversal-results (progn (setf seen-objects nil) (paths-to-object-slot-kvs-matching-to-depth (lambda (o) (let* ((search-regex "view")) (cond ((stringp o) (scan search-regex o)) ((symbolp o) (or (cl-ppcre::scan search-regex (symbol-name o)) (cl-ppcre::scan (string-upcase search-regex) (string-upcase (symbol-name o))) (cl-ppcre::scan (string-downcase search-regex) (string-downcase (symbol-name o)))))))) (drei::current-window) 4 :kv-access-function 'car))) |

Screenshot: http://old.sigkill.dk/athas/climdshots/6.png

The X connection dies on the server side, and all CLIM panes stop rendering. Under some very limited circumstances one can use a restart to fix this (#20 (comment) https://github.com/robert-strandh/McCLIM/issues/20#issuecomment-200644782). This error is particularly insidious because it means you must restart your machine or the X server, losing all state. It is often encountered when using the CLIM-DEBUGGER, which prints large structures in the frames.

To reproduce: Open up the listener and evaluate |(climi::with-text-size (t 1200) (princ "?"))|

The X server's "max-request-size" parameter does not appear to be the problem.

(in-package xlib) (defparameter proposed-maximum-request-size (WITH-DISPLAY "" (DISPLAY SCREEN _) (DISPLAY-MAX-REQUEST-LENGTH DISPLAY)))

If anyone has a strategy for interrogating the X server about its state, I would like to hear it. All I've got is a pointer to xlibtrace, which won't compile unless you use the patch in this stackoverflow post (in the later comments iirc). http://kev.pulo.com.au/xlibtrace http://stackoverflow.com/questions/2349538/xlib-integrated-debugging-tracing/2350412#2350412

It would be neat to utilize the CL::SIGNAL mechanism to take any 'invalid' output record and instead render (draw-text* stream "the drawing routine passed ~S violates such and such X server") and simply forget about the whole thing until we move to writing directly to framebuffer.

The R-TREES(?) error

As of yet we don't have a reproducible test case, though I'm sure anyone who has been working with McCLIM+stumpwm for any length of time probably knows the 'effect'. I ignore it on a daily basis.

Screenshot: http://imgur.com/YIltuZe

When moving around / rotating through / resizing X level windows you will sometimes have the contents of one output record appear in the place of another. If you press C-t C-t 2x on stumpwm to run the command pull-hidden-other, the rendering will be repaired (flushing a buffer somewhere?).

— You are receiving this because you are subscribed to this thread. Reply to this email directly, view it on GitHub https://github.com/robert-strandh/McCLIM/issues/55, or mute the thread https://github.com/notifications/unsubscribe-auth/ADK2dpMvaUeofYmIHtp-fZ5nlVG6Fdggks5qYq-4gaJpZM4JTeRZ.

gabriel-laddel commented 8 years ago

Alessandro's patch replaces these two sexprs in the file named above. It works so far, though there still might be some stuff that crashes X. The lack of ghosting/corruption/what I thought was an r-trees error is lovely, as are his debugging skills.

(defun font-generate-glyph (font glyph-index)
  (let* ((display (truetype-face-display font))
         (glyph-id (display-draw-glyph-id display)))
    (multiple-value-bind (arr left top dx dy) (glyph-pixarray font (code-char glyph-index))
      (with-slots (fixed-width) font
        (when (and (numberp fixed-width)
                   (/= fixed-width dx))
          (setf fixed-width t)
          (#-hef warn #+hef cerror #+hef "Ignore it." "Font ~A is fixed width, but the glyph width appears to vary.
 Disabling fixed width optimization for this font. ~A vs ~A" 
                 font dx fixed-width))
        (when (and (numberp fixed-width)
                   (font-fixed-width-p font))
          (setf fixed-width dx)))

      (when (= (array-dimension arr 0) 0)
        (setf arr (make-array (list 1 1)
                              :element-type '(unsigned-byte 8)
                              :initial-element 0)))
      (when (> (array-total-size arr)
           (- (* 4 (xlib::DISPLAY-MAX-REQUEST-LENGTH DISPLAY))
          100 ;; size of the header
          ))
    (error "The size of the font is too big"))
      (xlib::render-add-glyph (display-the-glyph-set display) glyph-id
                              :data arr
                              :x-origin (- left)
                              :y-origin top
                              :x-advance dx
                              :y-advance dy)
      (let ((right (+ left (array-dimension arr 1))))
        (glyph-info glyph-id dx dy left right top)))))

(defvar *draw-font-lock* (climi::make-lock "draw-font")) ; add me above medium-draw-text*

(defmethod medium-draw-text* ((medium clx-medium) string x y
                              start end
                              align-x align-y
                              toward-x toward-y transform-glyphs)
  (declare (ignore toward-x toward-y transform-glyphs))
  (climi::with-lock-held (*draw-font-lock*)
    (with-transformed-position ((sheet-native-transformation (medium-sheet medium))
                x y)
      (with-clx-graphics (medium) 
    (when (characterp string)
      (setq string (make-string 1 :initial-element string)))
    (when (null end) (setq end (length string)))
    (multiple-value-bind (text-width text-height x-cursor y-cursor baseline)
        (text-size medium string :start start :end end)
      (declare (ignore x-cursor y-cursor))

      (unless (and (eq align-x :left) (eq align-y :baseline))
        (setq x (- x (ecase align-x
               (:left 0)
               (:center (round text-width 2))
               (:right text-width))))
        (setq y (ecase align-y
              (:top (+ y baseline))
              (:center (+ y baseline (- (floor text-height 2))))
              (:baseline y)
              (:bottom (+ y baseline (- text-height))))))

      (let ((x (round-coordinate x))
        (y (round-coordinate y)))
        (when (and (<= #x-8000 x #x7FFF)
               (<= #x-8000 y #x7FFF))
          (font-draw-glyphs
           (text-style-to-X-font (port medium) (medium-text-style medium))
           mirror gc x y string
           #| x (- y baseline) (+ x text-width) (+ y (- text-height baseline )) |#
           :start start :end end
           :translate #'translate))))))))
gabriel-laddel commented 8 years ago

The connection to the X server still crashes from time to time, though I do not yet have a good test case. If you want to fix this, simply enable the clim debugger and work in climacs + the listener for a while and it'll occur.

One showstopping error down and one to go.

fiddlerwoaroof commented 8 years ago

I've experimented a bit with this using a test case mentioned on IRC:

(with-text-size (t *font-size*)
   (princ "lol"))

When *font-size* > 715 it signals a condition, when *font-size* < 715 it works and when *font-size* = 715 the connection to the X server crashes.

gabriel-laddel commented 8 years ago

@fiddlerwoaroof and all future readers. The text size issue is fixed. Simply replace font-generate-glyph with the version 2 posts up. One can still hose the X connection under a variety of conditions, and these are what we need to document / reduce to a handful of informative test cases.

gabriel-laddel commented 8 years ago

Regarding the last remaining error - _Connection to X server crashes because ???_

A relevent tidbit from the logs:

[irrelevent messages removed]

gabriel_laddel  oleu: do you have the problem of the X server connection being dropped from time to time?
gabriel_laddel  oleo: https://github.com/robert-strandh/McCLIM/issues/55
gabriel_laddel  ^ there is a useful patch in there that fixes the "ghosting" issue
gabriel_laddel  oleo: I'm curious what happens if you (in-package climi) (with-text-size (t 900) (princ "lol")) at the listener?
oleo    gabriel_laddel: aaah
oleo    gabriel_laddel: i didn't get that error via mcclim actually, i got it with wxmaxima too
gabriel_laddel  oleo: what.
gabriel_laddel  oleo: sorry, which error?
oleo    gabriel_laddel: the X crashing error
gabriel_laddel  oleo: ic. wtf, why would that happen in wxmaxima?
gabriel_laddel  isn't that a tlk/tk program?
oleo    it happens there too from time to time
oleo    i dunno why
gabriel_laddel  Bizzare. Of course, the bit of algol in the loop ruins the whole thing..
oleo    especially when you run it overnight have at least two instances have firefox running in addition and you want to close it by clicking the exit buttons on the windows, sometimes it crashes X
oleo    not sure if there's some memory hog thing sitting there......
oleo    or if some cache access things get confused......
oleo    yes, memory has to be big
oleo    i use like 3Gb almost
gabriel_laddel  oleo: that's an interesting idea.

-- http://irclog.tymoon.eu/freenode/%23clim?around=2016-08-12T14:27:43&types=mnaot#1471012063

Tackling this bug

Again, we still don't have a reproducible test case for this error.

dkochmanski commented 8 years ago

I believe I've found the cause of the problem (it was in CLX).

Basically xrender extension calls write-image-z without the necessary checks (which are performed by put-image with respect to max request size etc). I'm done with it today, but tomorrow I hope to fix the problem.

Proposed solution: do necessary checks in render-add-glyph (the second place wher the write-image-z is called, no other references).

dkochmanski commented 8 years ago

Also the provided fix does take into account the header, but doesn't take additional header written to render the glyph:

(with-buffer-request (display (extension-opcode display "RENDER"))
          (data +X-RenderAddGlyphs+)
          (length (ceiling request-length 4))
          (glyph-set glyph-set)
          (card32 1) ;number glyphs
          (card32 id) ;id
          (card16 w)
          (card16 h)
          (int16 x-origin)
          (int16 y-origin)
          (int16 x-advance)
          (int16 y-advance)

that's why if the text size is 715 it still crashes (it fits between one value and the other one)

dkochmanski commented 8 years ago

I believe https://github.com/sharplispers/clx/pull/43 should fix the problem

gabriel-laddel commented 8 years ago

Apparently I spoke to soon wrt the reproducible test case. Perhaps tomorrow (if you read this and think: ~ wtf ~, that makes two of us). We do have a description of the bug in question, which you ~will encounter if you hack with (setf *debugger-hook* 'clim-debugger:debugger) for an ~hour.

The issue occurs in XLIB::BUFFER-FLUSH, which is fed the current display as the BUFFER argument (nfi why the name). The BUFFER-BOFFSET slot is calculated incorrectly, and when BUFFER-FLUSH calls XLIB::BUFFER-WRITE, it gives incorrect coordinates to a sequence generating an out-of-bounds error.

The bounding indices 0 and 15844 are bad for a sequence of length 8192.
   [Condition of type SB-KERNEL:BOUNDING-INDICES-BAD-ERROR]
See also:
  Common Lisp Hyperspec, bounding index designator [:glossary]
  Common Lisp Hyperspec, SUBSEQ-OUT-OF-BOUNDS:IS-AN-ERROR [:issue]

Restarts:
 0: [CLEAR-PANE-TRY-AGAIN] Clear the output history of the pane and reattempt forceful redisplay
 1: [CLEAR-PANE] Clear the output history of the pane, but don't redisplay
 2: [SKIP-REDISPLAY] Skip this redisplay
 3: [ABORT] Return to application command loop
 4: [TRY-RECOMPILING] Recompile a and try loading it again
 5: [RETRY] Retry loading FASL for #<CL-SOURCE-FILE "hypersphere" "a">.
 --more--

Backtrace:
  0: (SB-INT:SEQUENCE-BOUNDING-INDICES-BAD-ERROR #(27 1 47 1 112 1 ...) 0 15844)
  1: (SB-IMPL::ANSI-STREAM-WRITE-SEQUENCE #(27 1 47 1 112 1 ...) #<SB-SYS:FD-STREAM for "socket, peer: /tmp/.X11-unix/X0" {100FBF4E33}> 0 15844)
  2: (WRITE-SEQUENCE #(27 1 47 1 112 1 ...) #<SB-SYS:FD-STREAM for "socket, peer: /tmp/.X11-unix/X0" {100FBF4E33}> :START 0 :END 15844)
  3: (XLIB::BUFFER-WRITE-DEFAULT #<unavailable argument> #<unavailable argument> #<unavailable argument> #<unavailable argument>)
  4: (XLIB::BUFFER-WRITE #(27 1 47 1 112 1 ...) #<DISPLAY :0 (The X.Orþ�Foundation R11604000)> 0 15844)
  5: (XLIB::BUFFER-FLUSH #<DISPLAY :0 (The X.Orþ�Foundation R11604000)>)
  6: ((FLET SB-THREAD::WITH-RECURSIVE-LOCK-THUNK :IN RENDER-COMPOSITE-GLYPHS))
  7: ((FLET #:WITHOUT-INTERRUPTS-BODY-647 :IN SB-THREAD::CALL-WITH-RECURSIVE-LOCK))
  8: (SB-THREAD::CALL-WITH-RECURSIVE-LOCK #<CLOSURE (FLET SB-THREAD::WITH-RECURSIVE-LOCK-THUNK :IN RENDER-COMPOSITE-GLYPHS) {7FFFE315FE5B}> #<SB-THREAD:MUTEX "CLX Buffer Lock" owner: #<SB-THREAD:THREAD "Li..
  9: (RENDER-COMPOSITE-GLYPHS #S(XLIB::PICTURE :ID 12583291 :DISPLAY #<DISPLAY :0 (The X.Orþ�Foundation R11604000)> :PLIST NIL :FORMAT #<XLIB::PICTURE-FORMAT 42 NIL 24 :DIRECT r8 g8 b8> :%CHANGED-P NIL :%S..
 10: ((FLET SB-THREAD::WITH-MUTEX-THUNK :IN CLIM:MEDIUM-DRAW-TEXT*))
 11: ((FLET #:WITHOUT-INTERRUPTS-BODY-618 :IN SB-THREAD::CALL-WITH-MUTEX))
 12: (SB-THREAD::CALL-WITH-MUTEX #<CLOSURE (FLET SB-THREAD::WITH-MUTEX-THUNK :IN CLIM:MEDIUM-DRAW-TEXT*) {7FFFE316024B}> #<SB-THREAD:MUTEX "draw-font" owner: #<SB-THREAD:THREAD "Listener" RUNNING {100888D7..
 13: ((:METHOD CLIM:MEDIUM-DRAW-TEXT* (CLIM-CLX::CLX-MEDIUM T T T T T T T T T T)) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> "15" 3 280233/512 0 2 :LEFT :BASELINE #<unavailable argument> #<unavailable argument> ..
 14: ((:METHOD CLIM:MEDIUM-DRAW-TEXT* :AROUND (CLIM-INTERNALS::TRANSFORM-COORDINATES-MIXIN T T T T T T T T T T)) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> "15" 3 280233/512 0 NIL :LEFT :BASELINE 4 280233/512 NI..
 15: ((:METHOD CLIM-INTERNALS::DO-GRAPHICS-WITH-OPTIONS-INTERNAL (CLIM:MEDIUM T T)) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLOSURE (FLET CLIM-INTERNALS::GRAPHICS-OP :IN..
 16: (CLIM:DRAW-TEXT* #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> "15" 3 280233/512 :TRANSFORMATION #<CLIM-INTERNALS::STANDARD-IDENTITY-TRANSFORMATION 1 0 0 1 0 0> :START 0 :END NIL)
 17: ((:METHOD CLIM-INTERNALS::STREAM-WRITE-OUTPUT :AROUND (CLIM:STANDARD-OUTPUT-RECORDING-STREAM T T)) #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> "15" NIL) [fast-method]
 18: ((:METHOD CLIM-INTERNALS::DO-GRAPHICS-WITH-OPTIONS-INTERNAL (CLIM:MEDIUM T T)) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLOSURE (FLET CLIM-INTERNALS::GRAPHICS-OP :IN..
 19: ((LABELS #:G429 :IN CLIM:INVOKE-WITH-DRAWING-OPTIONS) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}>)
 20: ((:METHOD CLIM:INVOKE-WITH-DRAWING-OPTIONS (CLIM:SHEET T)) #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> #<CLOSURE (FLET #:GCONTINUATION7136 :IN CLIM:REPLAY-OUTPUT-RECORD) ..
 21: ((LABELS #:G7123 :IN CLIM:REPLAY-OUTPUT-RECORD) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}>)
 22: ((:METHOD CLIM:REPLAY-OUTPUT-RECORD (CLIM-INTERNALS::STANDARD-TEXT-DISPLAYED-OUTPUT-RECORD T)) #<CLIM-INTERNALS::STANDARD-TEXT-DISPLAYED-OUTPUT-RECORD 3,274671/512 ("15" ": ") {1008F20A83}> #<CLIM-DEB..
 23: ((:METHOD CLIM-INTERNALS::DO-GRAPHICS-WITH-OPTIONS-INTERNAL (CLIM:MEDIUM T T)) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLOSURE (FLET CLIM-INTERNALS::GRAPHICS-OP :IN..
 24: ((LABELS #:G429 :IN CLIM:INVOKE-WITH-DRAWING-OPTIONS) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}>)
 25: ((:METHOD CLIM:INVOKE-WITH-DRAWING-OPTIONS (CLIM:SHEET T)) #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> #<CLOSURE (FLET #:GCONTINUATION2742 :IN CLIM:REPLAY-OUTPUT-RECORD) ..
 26: ((:METHOD CLIM:REPLAY-OUTPUT-RECORD :AROUND (CLIM-INTERNALS::GS-INK-MIXIN T)) #<CLIM-INTERNALS::STANDARD-TEXT-DISPLAYED-OUTPUT-RECORD 3,274671/512 ("15" ": ") {1008F20A83}> #<CLIM-DEBUGGER::DEBUGGER-P..
 27: ((:METHOD CLIM:MAP-OVER-OUTPUT-RECORDS-OVERLAPPING-REGION (T CLIM:STANDARD-SEQUENCE-OUTPUT-RECORD T)) #<STANDARD-GENERIC-FUNCTION CLIM:REPLAY-OUTPUT-RECORD (22)> #<CLIM:STANDARD-CELL-OUTPUT-RECORD X 3..
 28: ((:METHOD CLIM-INTERNALS::DO-GRAPHICS-WITH-OPTIONS-INTERNAL (CLIM:MEDIUM T T)) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLOSURE (FLET CLIM-INTERNALS::GRAPHICS-OP :IN..
 29: ((LABELS #:G429 :IN CLIM:INVOKE-WITH-DRAWING-OPTIONS) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}>)
 30: ((:METHOD CLIM:INVOKE-WITH-DRAWING-OPTIONS (CLIM:SHEET T)) #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> #<CLOSURE (FLET #:GCONTINUATION885 :IN CLIM:REPLAY-OUTPUT-RECORD) {..
 31: ((:METHOD CLIM:REPLAY-OUTPUT-RECORD (CLIM-INTERNALS::COMPOUND-OUTPUT-RECORD T)) #<CLIM:STANDARD-CELL-OUTPUT-RECORD X 3:24 Y 274671/512:281535/512 {1008F20513}> #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBU..
 32: ((:METHOD CLIM:MAP-OVER-OUTPUT-RECORDS-OVERLAPPING-REGION (T CLIM:STANDARD-SEQUENCE-OUTPUT-RECORD T)) #<STANDARD-GENERIC-FUNCTION CLIM:REPLAY-OUTPUT-RECORD (22)> #<CLIM:STANDARD-PRESENTATION 3:375,274..
 33: ((:METHOD CLIM-INTERNALS::DO-GRAPHICS-WITH-OPTIONS-INTERNAL (CLIM:MEDIUM T T)) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLOSURE (FLET CLIM-INTERNALS::GRAPHICS-OP :IN..
 34: ((LABELS #:G429 :IN CLIM:INVOKE-WITH-DRAWING-OPTIONS) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}>)
 35: ((:METHOD CLIM:INVOKE-WITH-DRAWING-OPTIONS (CLIM:SHEET T)) #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> #<CLOSURE (FLET #:GCONTINUATION885 :IN CLIM:REPLAY-OUTPUT-RECORD) {..
 36: ((:METHOD CLIM:REPLAY-OUTPUT-RECORD (CLIM-INTERNALS::COMPOUND-OUTPUT-RECORD T)) #<CLIM:STANDARD-PRESENTATION 3:375,274671/512:281535/512 CLIM-DEBUGGER::STACK-FRAME {1008F20273}> #<CLIM-DEBUGGER::DEBUG..
 37: ((:METHOD CLIM:MAP-OVER-OUTPUT-RECORDS-OVERLAPPING-REGION (T CLIM:STANDARD-SEQUENCE-OUTPUT-RECORD T)) #<STANDARD-GENERIC-FUNCTION CLIM:REPLAY-OUTPUT-RECORD (22)> #<CLIM:STANDARD-ROW-OUTPUT-RECORD X 3:..
 38: ((:METHOD CLIM-INTERNALS::DO-GRAPHICS-WITH-OPTIONS-INTERNAL (CLIM:MEDIUM T T)) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLOSURE (FLET CLIM-INTERNALS::GRAPHICS-OP :IN..
 39: ((LABELS #:G429 :IN CLIM:INVOKE-WITH-DRAWING-OPTIONS) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}>)
 40: ((:METHOD CLIM:INVOKE-WITH-DRAWING-OPTIONS (CLIM:SHEET T)) #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> #<CLOSURE (FLET #:GCONTINUATION885 :IN CLIM:REPLAY-OUTPUT-RECORD) {..
 41: ((:METHOD CLIM:REPLAY-OUTPUT-RECORD (CLIM-INTERNALS::COMPOUND-OUTPUT-RECORD T)) #<CLIM:STANDARD-ROW-OUTPUT-RECORD X 3:375 Y 274671/512:281535/512 {1008F20093}> #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBU..
 42: ((:METHOD CLIM:MAP-OVER-OUTPUT-RECORDS-OVERLAPPING-REGION (T CLIM:STANDARD-SEQUENCE-OUTPUT-RECORD T)) #<STANDARD-GENERIC-FUNCTION CLIM:REPLAY-OUTPUT-RECORD (22)> #<CLIM:STANDARD-TABLE-OUTPUT-RECORD X ..
 43: ((:METHOD CLIM-INTERNALS::DO-GRAPHICS-WITH-OPTIONS-INTERNAL (CLIM:MEDIUM T T)) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLIM-CLX::CLX-MEDIUM {10071EDA13}> #<CLOSURE (FLET CLIM-INTERNALS::GRAPHICS-OP :IN..
 44: ((LABELS #:G429 :IN CLIM:INVOKE-WITH-DRAWING-OPTIONS) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}>)
 45: ((:METHOD CLIM:INVOKE-WITH-DRAWING-OPTIONS (CLIM:SHEET T)) #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> #<CLOSURE (FLET #:GCONTINUATION885 :IN CLIM:REPLAY-OUTPUT-RECORD) {..
 46: ((:METHOD CLIM:REPLAY-OUTPUT-RECORD (CLIM-INTERNALS::COMPOUND-OUTPUT-RECORD T)) #<CLIM:STANDARD-TABLE-OUTPUT-RECORD X 3:47908 Y 156351/512:320975/512 {1008841973}> #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-..
 47: ((LABELS #:G853 :IN CLIM:REPLAY) #<CLIM-CLX::CLX-MEDIUM {10071EDA13}>)
 48: (CLIM:REPLAY #<CLIM:STANDARD-TABLE-OUTPUT-RECORD X 3:47908 Y 156351/512:320975/512 {1008841973}> #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> #<CLIM:STANDARD-BOUNDING-RECT..
 49: ((FLET #:CONTINUATION441 :IN CLIM-INTERNALS::INVOKE-FORMATTING-TABLE) #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> #<CLIM:STANDARD-TABLE-OUTPUT-RECORD X 3:47908 Y 156351/5..
 50: ((:METHOD CLIM:INVOKE-WITH-NEW-OUTPUT-RECORD (CLIM:OUTPUT-RECORDING-STREAM T T T)) #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> #<CLOSURE (FLET #:CONTINUATION441 :IN CLIM-..
 51: (CLIM-INTERNALS::INVOKE-FORMATTING-TABLE #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> #<FUNCTION (LABELS #:.CONT.2 :IN CLIM-DEBUGGER::DISPLAY-BACKTRACE) {1015BDCFDB}> :X-S..
 52: (CLIM-DEBUGGER::DISPLAY-DEBUGGER #<CLIM-DEBUGGER::CLIM-DEBUGGER {1006A14053}> #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}>)
 53: ((:METHOD CLIM:REDISPLAY-FRAME-PANE (CLIM:APPLICATION-FRAME CLIM-INTERNALS::PANE-DISPLAY-MIXIN)) #<CLIM-DEBUGGER::CLIM-DEBUGGER {1006A14053}> #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PAN..
 54: ((:METHOD CLIM:REDISPLAY-FRAME-PANE :AROUND (CLIM:APPLICATION-FRAME T)) #<CLIM-DEBUGGER::CLIM-DEBUGGER {1006A14053}> #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C43713}> :FORCE-P ..
 55: ((:METHOD CLIM:MAP-OVER-SHEETS (T CLIM:BASIC-SHEET)) #<CLOSURE (LAMBDA (CLIM:SHEET) :IN CLIM:REDISPLAY-FRAME-PANES) {1007FF5AFB}> #<CLIM-DEBUGGER::DEBUGGER-PANE CLIM-DEBUGGER::DEBUGGER-PANE {1006C4371..
 56: ((:METHOD CLIM:MAP-OVER-SHEETS (T CLIM:BASIC-SHEET)) #<CLOSURE (LAMBDA (CLIM:SHEET) :IN CLIM:REDISPLAY-FRAME-PANES) {1007FF5AFB}> #<CLIM-EXTENSIONS:VIEWPORT-PANE "(Unnamed Pane)" {100741D803}>) [fast-..
 57: ((:METHOD CLIM:MAP-OVER-SHEETS (T CLIM:BASIC-SHEET)) #<CLOSURE (LAMBDA (CLIM:SHEET) :IN CLIM:REDISPLAY-FRAME-PANES) {1007FF5AFB}> #<CLIM:SCROLLER-PANE "(Unnamed Pane)" {1007421783}>) [fast-method]
 58: ((:METHOD CLIM:MAP-OVER-SHEETS (T CLIM:BASIC-SHEET)) #<CLOSURE (LAMBDA (CLIM:SHEET) :IN CLIM:REDISPLAY-FRAME-PANES) {1007FF5AFB}> #<CLIM:VRACK-PANE "(Unnamed Pane)" {1007427283}>) [fast-method]
 59: ((:METHOD CLIM:MAP-OVER-SHEETS (T CLIM:BASIC-SHEET)) #<CLOSURE (LAMBDA (CLIM:SHEET) :IN CLIM:REDISPLAY-FRAME-PANES) {1007FF5AFB}> #<CLIM:VRACK-PANE "(Unnamed Pane)" {1007428E43}>) [fast-method]
 60: ((:METHOD CLIM:MAP-OVER-SHEETS (T CLIM:BASIC-SHEET)) #<CLOSURE (LAMBDA (CLIM:SHEET) :IN CLIM:REDISPLAY-FRAME-PANES) {1007FF5AFB}> #<CLIM-INTERNALS::TOP-LEVEL-SHEET-PANE CLIM-INTERNALS::TOP-LEVEL-SHEET..
 61: ((:METHOD CLIM:DEFAULT-FRAME-TOP-LEVEL (CLIM:APPLICATION-FRAME)) #<CLIM-DEBUGGER::CLIM-DEBUGGER {1006A14053}> :COMMAND-PARSER CLIM:COMMAND-LINE-COMMAND-PARSER :COMMAND-UNPARSER CLIM:COMMAND-LINE-COMMA..
 62: ((:METHOD CLIM:RUN-FRAME-TOP-LEVEL (CLIM:APPLICATION-FRAME)) #<CLIM-DEBUGGER::CLIM-DEBUGGER {1006A14053}>) [fast-method]
 63: ((:METHOD CLIM:RUN-FRAME-TOP-LEVEL :AROUND (CLIM:APPLICATION-FRAME)) #<CLIM-DEBUGGER::CLIM-DEBUGGER {1006A14053}>) [fast-method]
 64: ((LAMBDA NIL :IN CLIM-DEBUGGER:DEBUGGER))
 65: ((FLET SWANK/BACKEND:CALL-WITH-DEBUGGING-ENVIRONMENT :IN "/root/quicklisp/dists/quicklisp/software/slime-v2.18/swank/sbcl.lisp") #<CLOSURE (LAMBDA NIL :IN CLIM-DEBUGGER:DEBUGGER) {100A56350B}>)
 66: (SB-DEBUG::RUN-HOOK *DEBUGGER-HOOK* #<SB-EXT:NAME-CONFLICT {100A562AA3}>)
 67: (INVOKE-DEBUGGER #<SB-EXT:NAME-CONFLICT {100A562AA3}>)
 68: (ERROR #<SB-EXT:NAME-CONFLICT {100A562AA3}>)
 69: (SB-EXT:NAME-CONFLICT #<PACKAGE "MASAMUNE"> USE-PACKAGE #<PACKAGE "RUCKSACK"> RUCKSACK:RUCKSACK RUCKSACK)
 70: ((FLET SB-IMPL::THUNK :IN USE-PACKAGE))
 71: ((FLET #:WITHOUT-INTERRUPTS-BODY-647 :IN SB-THREAD::CALL-WITH-RECURSIVE-LOCK))
 72: (SB-THREAD::CALL-WITH-RECURSIVE-LOCK #<CLOSURE (FLET SB-THREAD::WITH-RECURSIVE-LOCK-THUNK :IN SB-IMPL::CALL-WITH-PACKAGE-GRAPH) {7FFFE316358B}> #<SB-THREAD:MUTEX "Package Graph Lock" owner: #<SB-THREA..
 73: (SB-IMPL::CALL-WITH-PACKAGE-GRAPH #<CLOSURE (FLET SB-IMPL::THUNK :IN USE-PACKAGE) {7FFFE31635DB}>)
 74: (USE-PACKAGE RUCKSACK #<PACKAGE "MASAMUNE">)
 75: (SB-FASL::LOAD-FASL-GROUP #S(SB-FASL::FASL-INPUT :STREAM #<SB-SYS:FD-STREAM for "file /root/.cache/common-lisp/sbcl-1.2.11-linux-x64/root/quicklisp/local-projects/hypersphere/a.fasl" {100A55D333}> :TA..
 76: (SB-FASL::LOAD-AS-FASL #<SB-SYS:FD-STREAM for "file /root/.cache/common-lisp/sbcl-1.2.11-linux-x64/root/quicklisp/local-projects/hypersphere/a.fasl" {100A55D333}> NIL NIL)
 77: ((FLET SB-FASL::LOAD-STREAM :IN LOAD) #<SB-SYS:FD-STREAM for "file /root/.cache/common-lisp/sbcl-1.2.11-linux-x64/root/quicklisp/local-projects/hypersphere/a.fasl" {100A55D333}> T)
 78: (LOAD #P"/root/.cache/common-lisp/sbcl-1.2.11-linux-x64/root/quicklisp/local-projects/hypersphere/a.fasl" :VERBOSE NIL :PRINT NIL :IF-DOES-NOT-EXIST T :EXTERNAL-FORMAT :DEFAULT)
 79: (UIOP/UTILITY:CALL-WITH-MUFFLED-CONDITIONS #<CLOSURE (LAMBDA NIL :IN UIOP/LISP-BUILD:LOAD*) {100A55B23B}> ("Overwriting already existing readtable ~S." #(#:FINALIZERS-OFF-WARNING :ASDF-FINALIZERS)))
 80: ((SB-PCL::EMF ASDF/ACTION:PERFORM) #<unavailable argument> #<unavailable argument> #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/LISP-ACTION:CL-SOURCE-FILE "hypersphere" "a">)
 81: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS (ASDF/LISP-ACTION:LOAD-OP ASDF/LISP-ACTION:CL-SOURCE-FILE)) #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/LISP-ACTION:CL-SOURCE-FILE "hypersphere" "a">) [..
 82: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS :AROUND (T T)) #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/LISP-ACTION:CL-SOURCE-FILE "hypersphere" "a">) [fast-method]
 83: ((:METHOD ASDF/PLAN:PERFORM-PLAN (LIST)) ((#1=#<ASDF/LISP-ACTION:COMPILE-OP > . #<ASDF/SYSTEM:SYSTEM "puri">) (#1# . #<ASDF/SYSTEM:SYSTEM "cl-base64">) (#1# . #<ASDF/SYSTEM:SYSTEM "trivial-gray-stream..
 84: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
 85: ((:METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)) ((#1=#<ASDF/LISP-ACTION:COMPILE-OP > . #<ASDF/SYSTEM:SYSTEM "puri">) (#1# . #<ASDF/SYSTEM:SYSTEM "cl-base64">) (#1# . #<ASDF/SYSTEM:SYSTEM "trivial-gray-s..
 86: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
 87: ((:METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)) #<ASDF/PLAN:SEQUENTIAL-PLAN {1006BF75D3}> :VERBOSE NIL) [fast-method]
 88: ((:METHOD ASDF/OPERATE:OPERATE (ASDF/OPERATION:OPERATION ASDF/COMPONENT:COMPONENT)) #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/SYSTEM:SYSTEM "hypersphere"> :VERBOSE NIL) [fast-method]
 89: ((SB-PCL::EMF ASDF/OPERATE:OPERATE) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/SYSTEM:SYSTEM "hypersphere"> :VERBOSE NIL)
 90: ((LAMBDA NIL :IN ASDF/OPERATE:OPERATE))
 91: ((:METHOD ASDF/OPERATE:OPERATE :AROUND (T T)) #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/SYSTEM:SYSTEM "hypersphere"> :VERBOSE NIL) [fast-method]
 92: ((SB-PCL::EMF ASDF/OPERATE:OPERATE) #<unused argument> #<unused argument> ASDF/LISP-ACTION:LOAD-OP "hypersphere" :VERBOSE NIL)
 93: ((LAMBDA NIL :IN ASDF/OPERATE:OPERATE))
 94: (ASDF/CACHE:CALL-WITH-ASDF-CACHE #<CLOSURE (LAMBDA NIL :IN ASDF/OPERATE:OPERATE) {1006BE344B}> :OVERRIDE NIL :KEY NIL)
 95: ((:METHOD ASDF/OPERATE:OPERATE :AROUND (T T)) ASDF/LISP-ACTION:LOAD-OP "hypersphere" :VERBOSE NIL) [fast-method]
 96: ((:METHOD ASDF/OPERATE:OPERATE :AROUND (T T)) ASDF/LISP-ACTION:LOAD-OP "hypersphere" :VERBOSE NIL) [fast-method]
 97: (ASDF/OPERATE:LOAD-SYSTEM "hypersphere" :VERBOSE NIL)
 98: (QUICKLISP-CLIENT::CALL-WITH-MACROEXPAND-PROGRESS #<CLOSURE (LAMBDA NIL :IN QUICKLISP-CLIENT::APPLY-LOAD-STRATEGY) {1006BA172B}>)
 99: (QUICKLISP-CLIENT::AUTOLOAD-SYSTEM-AND-DEPENDENCIES "hypersphere" :PROMPT NIL)
 100: ((:METHOD QUICKLISP-CLIENT:QUICKLOAD (T)) #<unavailable argument> :PROMPT NIL :SILENT NIL :VERBOSE T) [fast-method]
 101: (QL-DIST::CALL-WITH-CONSISTENT-DISTS #<CLOSURE (LAMBDA NIL :IN QUICKLISP-CLIENT:QUICKLOAD) {1006A69A2B}>)
 102: (MASAMUNE-GUI::MAYBE-RUN-HYPERSPHERE)
 103: ((:METHOD CLIM:CALL-PRESENTATION-TRANSLATOR (CLIM-INTERNALS::PRESENTATION-ACTION T T T T T T T)) #<Action from MASAMUNE-GUI::SPLASH-BUTTON to CLIM:COMMAND {1015BA08C3}> #<CLIM:STANDARD-PRESENTATION 15..
 104: (CLIM:THROW-HIGHLIGHTED-PRESENTATION #<CLIM:STANDARD-PRESENTATION 15.5:179,177.5:363 MASAMUNE-GUI::SPLASH-BUTTON {100547B1E3}> (((OR # CLIM:FORM) . #<CLOSURE (LAMBDA # :IN CLIM-INTERNALS::%ACCEPT) {10..
 105: ((SB-PCL::EMF CLIM:FRAME-INPUT-CONTEXT-BUTTON-PRESS-HANDLER) #<unavailable argument> #<unavailable argument> #<CLIM-LISTENER::LISTENER {10114053A3}> #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LIST..
 106: ((:METHOD CLIM:STREAM-READ-GESTURE (CLIM:STANDARD-EXTENDED-INPUT-STREAM)) #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LISTENER::INTERACTOR {1011C30A13}> :TIMEOUT NIL :PEEK-P NIL :INPUT-WAIT-TEST #<..
 107: ((SB-PCL::EMF CLIM:STREAM-READ-GESTURE) #<unused argument> #<unused argument> #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LISTENER::INTERACTOR {1011C30A13}> :TIMEOUT NIL :PEEK-P NIL :INPUT-WAIT-TES..
 108: ((:METHOD CLIM:STREAM-READ-GESTURE :AROUND (CLIM-INTERNALS::DEAD-KEY-MERGING-MIXIN)) #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LISTENER::INTERACTOR {1011C30A13}> :TIMEOUT NIL :PEEK-P NIL :INPUT-W..
 109: (ESA::ESA-READ-GESTURE :COMMAND-PROCESSOR #<DREI:DREI-AREA TEXTUAL-DREI-SYNTAX-VIEW {10089851B3}> :STREAM NIL)
 110: ((:METHOD ESA:PROCESS-GESTURES-OR-COMMAND (ESA:COMMAND-PROCESSOR)) #<DREI:DREI-AREA TEXTUAL-DREI-SYNTAX-VIEW {10089851B3}>) [fast-method]
 111: ((:METHOD ESA:PROCESS-GESTURES-OR-COMMAND :AROUND (ESA:COMMAND-PROCESSOR)) #<DREI:DREI-AREA TEXTUAL-DREI-SYNTAX-VIEW {10089851B3}>) [fast-method]
 112: ((LAMBDA NIL :IN DREI::READ-GESTURES-AND-ACT))
 113: ((:METHOD DREI-CORE::INVOKE-WITH-NARROWED-BUFFER (DREI:DREI DREI-BUFFER:LEFT-STICKY-MARK DREI-BUFFER:RIGHT-STICKY-MARK FUNCTION)) #<DREI:DREI-AREA TEXTUAL-DREI-SYNTAX-VIEW {10089851B3}> #<DREI-BUFFER:..
 114: (DREI::READ-GESTURES-AND-ACT #<CLIM:STANDARD-INPUT-EDITING-STREAM {1008984C33}> #<CLIM:KEY-PRESS-EVENT {10089DB903}> NIL)
 115: ((:METHOD CLIM:STREAM-READ-GESTURE (DREI:DREI-INPUT-EDITING-MIXIN)) #<CLIM:STANDARD-INPUT-EDITING-STREAM {1008984C33}> :TIMEOUT NIL :PEEK-P T :INPUT-WAIT-TEST #<FUNCTION CLIM-INTERNALS::INPUT-CONTEXT-..
 116: ((:METHOD CLIM-INTERNALS::%ACCEPT (CLIM-INTERNALS::|(presentation-type CLIM::COMMAND-OR-FORM)| T T CLIM:TEXTUAL-VIEW)) #<CLIM-INTERNALS::|(presentation-type CLIM::COMMAND-OR-FORM)| {1009118AF3}> CLIM:..
 117: ((:METHOD CLIM-INTERNALS::%ACCEPT :AROUND (CLIM-INTERNALS::|(presentation-type CLIM::COMMAND-OR-FORM)| T DREI:DREI-INPUT-EDITING-MIXIN T)) #<CLIM-INTERNALS::|(presentation-type CLIM::COMMAND-OR-FORM)|..
 118: ((FLET #:INPUT-CONT1465 :IN CLIM:ACCEPT-1))
 119: (CLIM-INTERNALS::INVOKE-HANDLE-EMPTY-INPUT #<CLIM:STANDARD-INPUT-EDITING-STREAM {1008984C33}> #<CLOSURE (FLET #:INPUT-CONT1465 :IN CLIM:ACCEPT-1) {7FFFE3165A5B}> #<CLOSURE (FLET #:HANDLER-CONT1466 :IN..
 120: ((LAMBDA (STREAM) :IN CLIM:ACCEPT-1) #<CLIM:STANDARD-INPUT-EDITING-STREAM {1008984C33}>)
 121: (CLIM-INTERNALS::INPUT-EDITING-RESCAN-LOOP #<CLIM:STANDARD-INPUT-EDITING-STREAM {1008984C33}> #<CLOSURE (LAMBDA (STREAM) :IN CLIM:ACCEPT-1) {1008984B4B}>)
 122: ((:METHOD CLIM-INTERNALS::INVOKE-WITH-INPUT-EDITING :AROUND (T T T T T)) #<CLIM:STANDARD-INPUT-EDITING-STREAM {1008984C33}> #<CLOSURE (LAMBDA (CLIM-INTERNALS::EDITING-STREAM) :IN CLIM-INTERNALS::INVOK..
 123: ((:METHOD CLIM-INTERNALS::INVOKE-WITH-INPUT-EDITING (CLIM:CLIM-STREAM-PANE T T T T)) #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LISTENER::INTERACTOR {1011C30A13}> #<CLOSURE (LAMBDA (STREAM) :IN CL..
 124: ((:METHOD CLIM-INTERNALS::INVOKE-WITH-INPUT-EDITING :AROUND (T T T T T)) #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LISTENER::INTERACTOR {1011C30A13}> #<CLOSURE (LAMBDA (STREAM) :IN CLIM:ACCEPT-1)..
 125: ((:METHOD CLIM-INTERNALS::INVOKE-WITH-INPUT-EDITING :AROUND (CLIM:EXTENDED-OUTPUT-STREAM T T T T)) #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LISTENER::INTERACTOR {1011C30A13}> #<CLOSURE (LAMBDA (..
 126: (CLIM:ACCEPT CLIM:COMMAND-OR-FORM :STREAM #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LISTENER::INTERACTOR {1011C30A13}> :PROMPT NIL :DEFAULT "hello" :DEFAULT-TYPE CLIM-LISTENER::EMPTY-INPUT)
 127: ((:METHOD CLIM:INVOKE-WITH-TEXT-STYLE (CLIM:MEDIUM T T)) #<CLIM-CLX::CLX-MEDIUM {1005447C93}> #<CLOSURE (FLET #:CONT472 :IN CLIM:INVOKE-WITH-TEXT-STYLE) {7FFFE31661CB}> #<CLIM:STANDARD-TEXT-STYLE :FIX..
 128: ((:METHOD CLIM:INVOKE-WITH-TEXT-STYLE (CLIM:SHEET T T)) #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LISTENER::INTERACTOR {1011C30A13}> #<FUNCTION (FLET #:CONT725 :IN CLIM:READ-FRAME-COMMAND) {10122..
 129: ((:METHOD CLIM:READ-FRAME-COMMAND (CLIM-LISTENER::LISTENER)) #<unused argument> :STREAM #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LISTENER::INTERACTOR {1011C30A13}>) [fast-method]
 130: ((:METHOD CLIM:READ-FRAME-COMMAND :AROUND (CLIM:APPLICATION-FRAME)) #<CLIM-LISTENER::LISTENER {10114053A3}> :STREAM #<CLIM-LISTENER::LISTENER-INTERACTOR-PANE CLIM-LISTENER::INTERACTOR {1011C30A13}>) [..
 131: ((:METHOD CLIM:DEFAULT-FRAME-TOP-LEVEL (CLIM:APPLICATION-FRAME)) #<CLIM-LISTENER::LISTENER {10114053A3}> :COMMAND-PARSER CLIM:COMMAND-LINE-COMMAND-PARSER :COMMAND-UNPARSER CLIM:COMMAND-LINE-COMMAND-UN..
 132: ((:METHOD CLIM:RUN-FRAME-TOP-LEVEL (CLIM:APPLICATION-FRAME)) #<CLIM-LISTENER::LISTENER {10114053A3}>) [fast-method]
 133: ((:METHOD CLIM:RUN-FRAME-TOP-LEVEL :AROUND (CLIM:APPLICATION-FRAME)) #<CLIM-LISTENER::LISTENER {10114053A3}>) [fast-method]
 134: ((FLET CLIM-LISTENER::RUN :IN CLIM-LISTENER:RUN-LISTENER))
 135: ((LAMBDA NIL :IN BORDEAUX-THREADS::BINDING-DEFAULT-SPECIALS))
 136: ((FLET #:WITHOUT-INTERRUPTS-BODY-1167 :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE))
 137: ((FLET SB-THREAD::WITH-MUTEX-THUNK :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE))
 138: ((FLET #:WITHOUT-INTERRUPTS-BODY-618 :IN SB-THREAD::CALL-WITH-MUTEX))
 139: (SB-THREAD::CALL-WITH-MUTEX #<CLOSURE (FLET SB-THREAD::WITH-MUTEX-THUNK :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE) {7FFFE3166D5B}> #<SB-THREAD:MUTEX "thread result lock" owner: #<SB-THREAD:THR..
 140: (SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE #<SB-THREAD:THREAD "Listener" RUNNING {100888D7D3}> NIL #<CLOSURE (LAMBDA NIL :IN BORDEAUX-THREADS::BINDING-DEFAULT-SPECIALS) {100888D75B}> (#1=#<SB-THRE..
 141: ("foreign function: call_into_lisp")
 142: ("foreign function: new_thread_trampoline")
gabriel-laddel commented 8 years ago

Test case: Evaluate the following at the listener, then ,toggle debugger to enable the clim debugger. (setf debugger-hook) does not work unless in a command for some reason.

(in-package clim-listener)

(define-listener-command (com-toggle-debugger :name t) ()
  (setf *debugger-hook*
        (if (or (eq #'swank:swank-debugger-hook *debugger-hook*)
                (eq 'swank:swank-debugger-hook *debugger-hook*))
            (progn (format t "Enabled clim deugger~%") 'clim-debugger:debugger)
            (progn (format t "Enabled swank deugger~%") 'swank::swank-debugger-hook))))

Download the following file to #p"/tmp/debugger.lisp" and (com-compile-and-load "/tmp/debugger.lisp") to generate the out of bounds error.

#| CLIM Debugger

TODO
----------------------------------------
- Elliott Johnson is to be thanked for the nice scroll-bars, but
  for some reason they don't remember their position when clicking
  on a stack-frame or "more".

- The break function does not use the clim-debugger --> Christophe
  Rhodes was kind enough to inform me that on SBCL,
  SB-EXT:*INVOKE-DEBUGGER-HOOK* takes care off this problem. I
  still don't know if this is a problem with other compilers.

- "Eval in frame" is not supported. I don't know of a good way to
   do this currently.

- Goto source location is not supported, but I think this could be
  done through slime.

- Currently the restart chosen by the clim-debugger is returned
  through the global variable *returned-restart*, this is not the
  best solution, but I do not know how of a better way to return a
  value from a clim frame, when it exits.

- There need to added keyboard shortcuts. 'q' should exit the
  debugger with an abort. '0', '1' and so forth should activate
  the restarts, like Slime. Maybe is should be possible to use the
  arrow keys as well. Then we have to add a notion of the current
  frame. Would this be useful?

|#

(in-package climi)

(defmacro bold ((stream) &body body)
  `(with-text-face (,stream :bold)
     ,@body))

(defclass debugger-info ()
  ((the-condition :accessor the-condition
              :initarg :the-condition)
   (condition-message :accessor condition-message
              :initarg  :condition-message)
   (type-of-condition :accessor type-of-condition
                  :initarg  :type-of-condition)
   (condition-extra :accessor condition-extra
                :initarg  :condition-extra)
   (restarts :accessor restarts
         :initarg :restarts)
   (backtrace :accessor backtrace
          :initarg :backtrace)))

(defclass minimized-stack-frame-view (textual-view)())
(defclass maximized-stack-frame-view (textual-view)())

(defparameter +minimized-stack-frame-view+ 
  (make-instance 'minimized-stack-frame-view))
(defparameter +maximized-stack-frame-view+ 
  (make-instance 'maximized-stack-frame-view))

(defclass stack-frame ()
  ((clim-view       :accessor view :initform +minimized-stack-frame-view+)
   (frame-string    :accessor frame-string
            :initarg  :frame-string)
   (frame-no        :accessor frame-no
            :initarg :frame-no)
   (frame-variables :accessor frame-variables
            :initarg :frame-variables)))

(defun compute-backtrace (start end)
  (loop for frame    in   (swank-backend::compute-backtrace start end)
    for frame-no from 0
    collect (make-instance
         'stack-frame
         :frame-string    (let ((*print-pretty* nil))
                    (with-output-to-string (stream) 
                      (swank-backend::print-frame frame stream)))
         :frame-no        frame-no
         :frame-variables (swank-backend::frame-locals frame-no))))

(defmethod expand-backtrace ((info debugger-info) (value integer))
  (with-slots (backtrace) info
    (setf backtrace (compute-backtrace 0 (+ (length backtrace) 10)))))

;;; CLIM stuff
;;; ----------------------------------------

(defclass debugger-pane (application-pane)
  ((condition-info :reader condition-info :initarg :condition-info)))

;; FIXME - These two variables should be removed!
;; Used to return the chosen reatart in the debugger.
(defparameter *returned-restart* nil)

;; Used to provide the clim frame with the condition info that
;; triggered the debugger.
(defparameter *condition* nil)

(defun make-debugger-pane ()
  (with-look-and-feel-realization ((frame-manager *application-frame*)
                   *application-frame*) 
    (make-pane 'debugger-pane 
           :condition-info *condition*
           :display-function #'display-debugger
           :end-of-line-action :allow
           :end-of-page-action :scroll)))

(gui clim-debugger (esa-frame-mixin standard-application-frame)
  () 
  (:esa-gui t :presentation-history? t)
  ()
  (:pointer-documentation t)
  (:panes (debugger-pane (make-debugger-pane))
          (interactor :interactor))
  (:layouts (:default (vertically () 
                        (scrolling () debugger-pane)
                        (250 interactor))))
  (:geometry :height 600 :width 800))

(defun run-debugger-frame ()
  (run-frame-top-level
   (make-application-frame 'clim-debugger)))

(define-presentation-type stack-frame () :inherit-from 't)
(define-presentation-type restart     ())
(define-presentation-type more-type   ())
(define-presentation-type inspect     ())

(define-clim-debugger-command (com-more :name "More backtraces")
    ((pane 'more-type))
  (expand-backtrace (condition-info pane) 10))

(define-clim-debugger-command (com-invoke-inspector :name "Invoke inspector")
    ((obj 'inspect))
  (clouseau:inspector obj))

(define-clim-debugger-command (com-refresh :name "Refresh" :menu t) ()
  (change-space-requirements (frame-panes *application-frame*)))

(define-clim-debugger-command (com-quit :name "Quit" :menu t) ()
  (frame-exit *application-frame*))

(define-clim-debugger-command (com-invoke-restart :name "Invoke restart")
    ((restart 'restart))
  (setf *returned-restart* restart)
  (frame-exit *application-frame*))

(define-clim-debugger-command (com-toggle-stack-frame-view 
                   :name "Toggle stack frame view")
    ((stack-frame 'stack-frame))
  (progn
    (if (eq +minimized-stack-frame-view+ (view stack-frame))
    (setf (view stack-frame) +maximized-stack-frame-view+)
    (setf (view stack-frame) +minimized-stack-frame-view+))
    (change-space-requirements (frame-panes *application-frame*))))

(define-presentation-to-command-translator more-backtraces
    (more-type com-more clim-debugger :gesture :select)
    (object)
  (list object))

(define-presentation-to-command-translator invoke-inspector
    (inspect com-invoke-inspector clim-debugger :gesture :select)
    (object)
  (list object))

(define-presentation-to-command-translator toggle-stack-frame-view
    (stack-frame com-toggle-stack-frame-view clim-debugger :gesture :select)
    (object)
  (list object))

(define-presentation-to-command-translator invoke-restart
    (restart com-invoke-restart clim-debugger :gesture :select)
    (object)
  (list object))

(defun std-form (pane first second &key (family :sans-serif))
  (formatting-row 
      (pane)
    (with-text-family (pane :sans-serif)
      (formatting-cell (pane) (bold (pane) (format t "~A" first))))
    (formatting-cell (pane)
      (with-text-family (pane family) 
       (format t "~A" second)))))

(defun display-debugger (frame pane)
  (let ((*standard-output* pane))
    (formatting-table (pane)
      (std-form pane "Condition type:" (type-of-condition (condition-info
                                 pane)))
      (std-form pane "Description:"    (condition-message (condition-info
                                                            pane)))
      (when (condition-extra (condition-info pane))
        (std-form pane "Extra:" (condition-extra (condition-info pane))
                  :family :fix)))
    (fresh-line)

    (with-text-family (pane :sans-serif)
      (bold (pane) (format t "Restarts:")))
    (fresh-line)
    (format t " ")
    (formatting-table 
    (pane)
      (loop for r in (restarts (condition-info pane))
        do (formatting-row (pane)
              (with-output-as-presentation (pane r 'restart)
                (formatting-cell (pane)
                  (format pane "~A" (restart-name r)))

                (formatting-cell (pane)
                  (with-text-family (pane :sans-serif)
                    (format pane "~A" r)))))))
    (fresh-line)
    (display-backtrace frame pane)
    (change-space-requirements pane
                  :width (bounding-rectangle-width (stream-output-history pane))
                  :height (bounding-rectangle-height (stream-output-history pane)))))

(defun display-backtrace (frame pane)
  (declare (ignore frame)) 
  (with-text-family (pane :sans-serif)
    (bold (pane) (format t "Backtrace:")))
  (fresh-line)
  (format t " ")
  (formatting-table 
      (pane)
    (loop for stack-frame in (backtrace (condition-info pane))
      for i from 0
      do (formatting-row (pane)
               (with-output-as-presentation (pane stack-frame 'stack-frame)
                 (bold (pane) (formatting-cell (pane) (format t "~A: " i)))
                 (formatting-cell (pane)
                   (present stack-frame 'stack-frame 
                            :view (view stack-frame))))))
    (when (>= (length (backtrace (condition-info pane))) 20)
      (formatting-row (pane)
        (formatting-cell (pane))
        (formatting-cell (pane)
          (bold (pane)
            (present pane 'more-type)))))))

(define-presentation-method present (object (type stack-frame) stream
                     (view minimized-stack-frame-view)
                     &key acceptably for-context-type)
  (declare (ignore acceptably for-context-type))
  (format t "~A  " (frame-string object)))

(define-presentation-method present (object (type stack-frame) stream
                     (view maximized-stack-frame-view)
                     &key acceptably for-context-type)
  (declare (ignore acceptably for-context-type))
  (progn
    (princ (frame-string object) stream)
    (fresh-line)
    (with-text-family (stream :sans-serif)
      (bold (stream) (format t "  Locals:")))
    (fresh-line)
    (format t "     ")
    (formatting-table 
     (stream)
     (loop for (name n identifier id value val) in (frame-variables object)
       do (formatting-row 
           (stream)
           (formatting-cell (stream) (format t "~A" n))
           (formatting-cell (stream) (format t "="))
           (formatting-cell (stream) (present val 'inspect)))))
    (fresh-line)))

(define-presentation-method present (object (type restart) stream
                     (view textual-view)
                     &key acceptably for-context-type)
  (declare (ignore acceptably for-context-type))
  (bold (stream) (format t "~A" (restart-name object))))

(define-presentation-method present (object (type more-type) stream
                     (view textual-view)
                     &key acceptably for-context-type)
  (declare (ignore acceptably for-context-type))
  (bold (stream) (format t "--- MORE ---")))

(define-presentation-method present (object (type inspect) stream
                     (view textual-view)
                     &key acceptably for-context-type)
  (declare (ignore acceptably for-context-type))
  (format t "~A" object))

;;; Starting the debugger
;;; ----------------------------------------

(defun debugger (condition me-or-my-encapsulation)
  (swank-backend::call-with-debugging-environment 
   (lambda ()
     (unwind-protect
      (progn 
        (setf 
         *condition* 
         (make-instance 
          'debugger-info
          :the-condition        condition
          :type-of-condition    (type-of condition)
          :condition-message    (swank::safe-condition-message condition)
          :condition-extra      (swank::condition-extras       condition)
          :restarts             (compute-restarts)
          :backtrace            (compute-backtrace 0 20)))
        (run-debugger-frame))
       (let ((restart *returned-restart*))
     (setf *returned-restart* nil)
     (setf *condition* nil)
     (if restart
         (let ((*debugger-hook* me-or-my-encapsulation))
           (invoke-restart-interactively restart))
         (abort)))))))
dkochmanski commented 8 years ago

the following recipe doesn't reproduce out-of-bounds bug for me.

As a side note, this file doesn't compile at all, because it uses some macros which I don't know where to pull from (most notably GUI macro).

Please provide some intelligible way to reproduce the issue, like:

So I can reproduce it from fresh sbcl image

gabriel-laddel commented 8 years ago

Well that's interesting. I don't have the GUI macro in the CLIMI package either. It isn't supposed to compile.

Le proof: http://imgur.com/a/zrfjb

root@jellyfish~# X -version

X.Org X Server 1.16.4
Release Date: 2014-12-20
X Protocol Version 11, Revision 0
Build Operating System: Linux 3.18.34-std473-amd64 x86_64 Gentoo
Current Operating System: Linux jellyfish 3.19.3-1~exp1 #1 SMP Sat Jun 11 22:18:14 2016 x86_64
Kernel command line: BOOT_IMAGE=/kernel-debian-sources-x86_64-3.19.3-1~exp1 rootfstype=auto real_root=/dev/sda3 rootfstype=ext4
Build Date: 11 June 2016  07:27:17AM

Current version of pixman: 0.32.6
    Before reporting problems, check http://wiki.x.org
    to make sure that you have the latest version.

EDIT: remember, if you really want to generate such an error (or demonstate that it's just my setup) all you have to do is enable the clim debugger and work in climacs + the listener for a few hours.

dkochmanski commented 8 years ago

but the backtrace is pretty useful, I think I may know where the problem is

gabriel-laddel commented 8 years ago

@dkochmanski do tell. Other people have REPLs open 24/7

dkochmanski commented 8 years ago

nope, that wasn't it. Backtrace still useful though.

gas2serra commented 8 years ago

I reproduce the crash of @gabriel-laddel. Firstly evaluate:

  (ql:quickload :mcclim)
  (ql:quickload :CLOUSEAU)
  (ql:quickload :clim-listener)
  (defparameter *mcclim-directory*
    (asdf:component-pathname (asdf:find-system "mcclim")))
  (load (merge-pathnames "Apps/Debugger/clim-debugger.lisp" *mcclim-directory*))
  (clim-listener:run-listener :new-process t)

Then, in the listener evaluate:

 (let ((*debugger-hook* #'clim-debugger:debugger))
    (load (compile-file "/tmp/debugger.lisp")))

The form "(load (compile-file "/tmp/debugger.lisp")))" can be substituted with others that loads and compiles long file that has errors.

gas2serra commented 8 years ago

The previous code tries to draw a string of 19203 chars.

dkochmanski commented 8 years ago

I think it's a thread-safety issue with stream-input-wait, not something specifically in debugger or the listener, but rather that we have two application frames.

dkochmanski commented 8 years ago

(thanks, I can reproduce the problem – it doesn't crash for me, but rather hang, but the problem is clearly visible).

gabriel-laddel commented 8 years ago

@dkochmanski it doesn't 'crash' for anyone, all of the application frames stop rendering and you should get an out of bounds error at the swank debugger (assuming debugger-hook is bound correctly).

dkochmanski commented 8 years ago

It's not a fix, but if you could confirm that this hack prevents the problem (like on my machine) it would be great:

diff --git a/Core/clim-basic/stream-input.lisp b/Core/clim-basic/stream-input.lisp
index 9c57da2..0f2345f 100644
--- a/Core/clim-basic/stream-input.lisp
+++ b/Core/clim-basic/stream-input.lisp
@@ -95,6 +95,7 @@
       (let ((event (event-queue-read-no-hang queue)))
         (cond (event
            (do-one-event event))
+                   #+ (or)
           (*multiprocessing-p*
            (event-queue-listen-or-wait queue))
           (t (process-next-event port)))))))))
@@ -352,6 +353,11 @@ keys read."))
         (return-from exit t))))
     ;; Event queue has been drained, time to block waiting for
     ;; new events.
+         (multiple-value-bind (result reason)
+             (process-next-event port :timeout timeout)
+           (unless result
+             (return-from exit (values nil reason))))
+         #+ (or)
     (if *multiprocessing-p*
         (unless (event-queue-listen-or-wait buffer :timeout timeout)
           (return-from exit (values nil :timeout)))
gabriel-laddel commented 8 years ago

@dkochmanski Your hack works! It slows down the environment >10x in my estimation, but your diagnosis is correct, and the hacks leaves climacs running so one can kill off the other threads and not lose their state. Bravo.

EDIT: here is a macroexpanded CLIM debugger. http://paste.lisp.org/display/324613

gas2serra commented 8 years ago

To reproduce:

(MAP-OVER-FRAMES
 (LAMBDA (X)
   (WHEN (STRING= (FRAME-NAME X) "LISTENER")
     (draw-text*
      (FIND-PANE-NAMED X 'CLIM-LISTENER::INTERACTOR)
      (with-output-to-string (strm)
    (dotimes (i 10000)
        (format strm ".")))
      100 100))))

Try it in the listener.

dkochmanski commented 8 years ago

OK, this is much better test-case. The problem with the array bounds is caused because the size of the output buffer doesn't match required size. To mitigate an error you can make the buffer bigger: (defparameter *output-buffer-size* 32768) in dependant.lisp in clx. That said, I'm still working for a solution how to fix it. Buffer management code in CLX is a mess.