Debugger fixes for protected blocks

Fixes for the Debugger to prevent crashes when debugging protected blocks:

Thanks to Manfred Möbus for this!

[codesyntax lang=”smalltalk”]

!Process methods !

dropFrames: frameCount
        "Private - discard the top <frameCount> stack frames
        from the receiver's stack. Requires that the receiver
        not be active.  Assumes the receiver is being debugged."
    | topFrameBeforeResumption sendFrameBeforeResumption runableBeforeResumption homeFrame |
    self == CurrentProcess
        ifTrue: [ ^self error: 'cannot drop frames from the active process.' ].
    frameCount = 0 ifTrue: [ ^self ].
    self class enableInterrupts: false.
    sendFrameBeforeResumption := sendFrame.
    topFrameBeforeResumption := self topFrame.
    runableBeforeResumption := self runable.

    self sendFrame: ( self processIndexToStackPointer: topFrameBeforeResumption ).
    self debugger notNil
        ifTrue: [ self debugger debuggingProcess: CurrentProcess ].
    [ self protectionBlock: ( self
        firstProtectionBlockWithin: frameCount
        removeMark: true ).
        self protectionBlock ~~ nil ]
            whileTrue: [
                self debugger notNil
                    ifTrue: [   "mm: added 'if > 0' check; expandFrame: would fail, and it is the wrong frame anyway
                                    - see homeFrameOfContext: which in some cases just returns 0 for 'no-valid-result'  "
                             (homeFrame := self homeFrameOfContext: self protectionBlock  ) > 0 ifTrue: [ 
                                    self debugger expandFrame: homeFrame ].].
                self evaluateOneProtectionBlock ].
    self debugger notNil
        ifTrue: [ self debugger debuggingProcess: nil ].
    self runable: runableBeforeResumption.
    self topFrame = topFrameBeforeResumption ifTrue: [
        frameCount timesRepeat: [ self dropFrameWithoutProtection].
        sendFrame := sendFrameBeforeResumption]! !




!Debugger methods !
   
expandFrame: frame
        "Private - create a debugging version of a frame."
    | process cm dcm offset oldOffset interruptFrame  arg |
    "mm: get out for frame=0 - this will fail since returnOffsetAt:  -1 will return wrong value
        and make #convert:to:offset: blow up the image - the real return value is probably
        (self at: 2) but this is unconfirmed - so for the while just don't expand this frame"
    frame = 0 ifTrue: [ ^self ].
    process := self debuggedProcess.
    cm := process methodAt: frame.
    cm isDebuggable
        ifTrue:
            [
            cm sourceIndex >= 3      "method source in dll"
                ifTrue: [ cm sourceObject: ( ( process receiverAt: frame )
                                methodFor: cm selector in: cm classField ) sourceString ]
            ]
        ifFalse:
            [
            interruptFrame := false.
            oldOffset :=  (process returnOffsetAt: frame - 1).
            (oldOffset = 0) ifTrue: [
                 interruptFrame := true.
                 oldOffset := process frameAt: frame - 1 offset: 7].
            (oldOffset = 1) ifTrue: [^self].
            dcm := cm asDebuggableMethod.
            offset := self convert: cm to: dcm offset: oldOffset.

"mm: make block contexts consistent with the replaced compiled method - 
  this was found necessary only for the protected frame (#ensure: or #ifCurtailed)
  as invoked by #hop-ing through a ^ return from block.
  The vm gets fooled by old and new return addresses in the next #copyStack in this case,
  and when the debugger calls #convert:to:offset with wrong values, a GPF results. "
            1 to: (process argumentCount: frame - 1) do: [ :i |
                arg := process stackArgAt: frame - 1 number: i.
                arg isBlockClosure ifTrue: [
                    (arg at: 1) == cm ifTrue: [
                        arg at: 1 put: dcm. ]]].

            process methodAt: frame put: dcm.
            interruptFrame ifTrue: [
               process frameAt: frame - 1 offset: 7 put: offset]
                                     ifFalse: [
                 process returnOffsetAt: frame - 1 put: offset ]
             ]! !
 


!Debugger methods !
   
hop
        "Private - resume process for one hop, i.e., to next expression or
        assignment at any method level."
    | process protectedFrameIndex  |
    self resumable
        ifFalse: [^self].
    process := self debuggedProcess.

    realFrame == nil
        ifFalse:
            [process topFrame: realFrame.
            realFrame := nil].

    self expandFrame: 2.
    self expandFrame: 3.

    "mm: ensure hopping (with ^ ) out of a block into protected frame will find its method
     already debuggable; otherwise VM would do this in assembler code,
     but does not implement the changes to blocks as added to #expandFrame: method"
    self inBlock ifTrue: [ 
        protectedFrameIndex := process firstProtectionFrame.
        protectedFrameIndex notNil ifTrue: [ self expandFrame: protectedFrameIndex + 1. ].].


    self label: 'hopping'.
    Process enableInterrupts: false.
    process sendFrame: 1.
    process debugger: self.
    process interruptFrame: 0.
    process runable: (process runable bitOr: 1).
    BreakPoints:= breakpointArray.
    UserInterfaceProcess := (process isUserIF
        ifTrue: [process]
        ifFalse: [nil]).
    CurrentProcess := process.
    process resume: 0! !
 


!Process methods !

firstProtectionFrame
        "Private - added by mm: answer the frame number of the first
         protection block in this process, or nil if none exists.
         (this is the frame where receiverAt: frame will return the FrameMarker,
          with the method #setUnwind:  )."
    | count index |
    count := 0.
    index := self processIndexFromBPLink: self topFrame.
    [(self at: index) ~= 0 ]
        whileTrue:
          [
           FrameMarker == (self at: index + ReceiverOffset)
                ifTrue: [^count ].
           count := count + 1.
           index := self nextFrameFrom: index].
    ^nil! !

[/codesyntax]