[info-mcl] process crash

[Terje Norderhaug]

On Jul 22, 2009, at 1:10 AM, peter wrote:
> Anyway, suggestion: that we detail with our posts the context in
> which we're doing anything on RMCL.
> Here I'm running vanilla RMCL with rmcl-clos-patch on MacOS 10.5.7  
> on MacPro.

Vanilla RMCL with no patches, MacOS 10.4.11 G4 Cube.

I have localized the crashes (at least those resulting from  
evaluating process-run-function in the listener) to #'%reverse- 
special-bindings as called from #'stack-group-resume in #'stack-group- 
preset. I wonder whether my findings are replicable in other  
configurations. Here is how to replicate the test using primitive  
breakpoints:

(defparameter *break* NIL)

(let ((*warn-if-redefine* nil)
       (*warn-if-redefine-kernel* nil))

(defun stack-group-resume (stack-group arg)
   (sg-buffer stack-group)               ; type check
   (when (eq stack-group *current-stack-group*)
     (return-from stack-group-resume arg))
   (when (%stack-group-exhausted-p stack-group)
     (error "Attempt to resume exhausted ~s" stack-group))
   (let (result)
     (without-interrupts
      (saving-graphics-port
        (catch '*inactive-stack-group-catch*
          (%ensure-vsp-stack-space)      ; make sure there's room for  
ppc-ff-call to save the saved registers
          (setq *next-stack-group* stack-group
                *resume-stack-group-arg* arg
                arg nil)                        ; allow GC
          (%lock-binding-stack)
(when *break*
    (setf *break* NIL)
    (break "Got here")
    (setf *break* T))
          (%reverse-special-bindings nil)  ;; <-------
(when *break*
    (setf *break* NIL)
    (break "But not beyond")
    (setf *break* T))
          (%normalize-areas)
          (%save-stack-group-context *current-stack-group*)
          (%unlock-binding-stack)
          ; (#_YieldToThread (sg.threadID stack-group))
          ; Do it explicitly to be doubly sure that it's resolved
          ; Calling back to resolve-slep-address in the current  
context is a bad idea
          ; unhold current, hold next?? - doesn't work
          ;(unhold-current-hold-next *current-stack-group* stack-group)
          (ppc-ff-call (%kernel-import ppc::kernel-import- 
xYieldToThread)
                       :signed-fullword (sg.threadID stack-group)
                       :signed-halfword)
          ;; xYieldToThread locks the binding stack here: we can't  
reliably do
          ;; an ff-call to %LOCK-BINDING-STACK until the incoming  
thread's context
          ;; is restored, but we don't want a timer interrupt to mess  
with anything
          ;; yet either.
          ;;(%lock-binding-stack)
          (%restore-stack-group-context *next-stack-group*)
          (%reverse-special-bindings t)
          (%unlock-binding-stack))
        (setq result *resume-stack-group-arg*
              *current-stack-group* *next-stack-group*
              *next-stack-group* nil
              *resume-stack-group-arg* nil)))
       (multiple-value-bind (value value-p) (handle-stack-group- 
interrupts)
         (when value-p
           (setq result value)))
       result))

) ; end redefine

Evaluate in the listener (or from Fred):

(let ((*break* T))
    (process-run-function "Boom?" (lambda () NIL)))

-- Terje Norderhaug