Debugging & SharedQueues[BUG][FIX?]

Bob Arning arning at charm.net
Sat Dec 18 20:55:54 UTC 1999


On Sat, 18 Dec 1999 18:46:12 +0100 Stefan Matthias Aust <sma at 3plus4.de> wrote:
>For me, this looks like the debugger doesn't resume the stopped process but
>continues to execute the fixed code in the UI process which is WRONG.

Hi Stefan,

That one looks like my fault. The debugger was terminating the current process (the one running the debugger UI) when you hit resume. Due to a fix I made earlier, that was the only UI process around, so you were dead until you interrupted. Please try the enclosed fix and see if it solves your problem.

Cheers,
Bob

==========
'From Squeak2.7alpha of 9 November 1999 [latest update: #1716] on 18 December 1999 at 3:49:47 pm'!
"Change Set:		debuggerUIfix
Date:			18 December 1999
Author:			Bob Arning

- This is a follow-up to a fix I submitted in June 99 which prevented the creation of two UI processes. Unfortunately, that fix made it possible for there to be *no* ui processes after a resume. With this fix, the debugger leaves the ui process in place on resume if it was not created solely to enable the debugger to work. The class QT is a simple test of this and can be deleted

to test getting an error in a non-ui process,

- evaluate (QT begin)		an inspector will open on a SharedQueue

in the inspector eval pane, do:
- evaluate (self nextPut: 1) 	the forked process will read the queue and beep
- evaluate (self nextPut: nil) 	the forked process will read the queue, beep and halt
- hit proceed on the debugger

IF the debugger fix is in, you can proceed to:

- evaluate (self nextPut: 0) 	the forked process will read the queue, beep and exit

IF the debugger fix is NOT in, you will have lost the UI at this point. Use cmd/alt-period to interrupt the running process and thus get a new UI process.
"!

CodeHolder subclass: #Debugger
	instanceVariableNames: 'interruptedProcess interruptedController contextStack contextStackTop contextStackIndex contextStackList receiverInspector contextVariablesInspector externalInterrupt proceedValue selectingPC sourceMap tempNames errorWasInUIProcess '
	classVariableNames: 'ContextStackKeystrokes ErrorRecursion '
	poolDictionaries: ''
	category: 'Tools-Debugger'!
Object subclass: #QT
	instanceVariableNames: ''
	classVariableNames: 'Q '
	poolDictionaries: ''
	category: 'Kernel-Objects'!

!Debugger methodsFor: 'initialize' stamp: 'RAA 12/18/1999 15:34'!
openFullNoSuspendLabel: aString
	"Create and schedule a full debugger with the given label. Do not terminate the current active process."

	| topView |
	Smalltalk isMorphic ifTrue:
		[self openFullMorphicLabel: aString.
		^ errorWasInUIProcess _ Project current spawnNewProcessIfNeeded].
	topView _ self buildMVCDebuggerViewLabel: aString minSize: 300 at 200.
	topView controller openNoTerminate.
	^ topView
! !

!Debugger methodsFor: 'initialize' stamp: 'RAA 12/18/1999 15:34'!
openNotifierContents: msgString label: label
	"Create and schedule a notifier view with the given label and message. A notifier view shows just the message or the first several lines of the stack, with a menu that allows the user to open a full debugger if so desired."
	"NOTE: When this method returns, a new process has been scheduled to run the windows, and thus this notifier, but the previous active porcess has not been suspended.  The sender will do this."
	| msg topView p |
	Sensor flushKeyboard.
	(label beginsWith: 'Space is low')
		ifTrue: [msg _ self lowSpaceChoices, msgString]
		ifFalse: [msg _ msgString].

	World ifNotNil: [
		self buildMorphicNotifierLabelled: label message: msg.
		^errorWasInUIProcess _ Project current spawnNewProcessIfNeeded
	].

	Display fullScreen.
	Cursor normal show.
	topView _ self buildMVCNotifierViewLabel: label message: msg minSize: 350@((14 * 5) + 16).
	ScheduledControllers activeController
		ifNil: [p _ Display boundingBox center]
		ifNotNil: [p _ ScheduledControllers activeController view displayBox center].
	topView controller openNoTerminateDisplayAt: (p max: (200 at 60)).
	^ topView
! !

!Debugger methodsFor: 'private' stamp: 'RAA 12/18/1999 15:35'!
resumeProcess: aTopView
	Smalltalk isMorphic ifFalse: [aTopView erase].
	interruptedProcess suspendedContext method
			== (Process compiledMethodAt: #terminate) ifFalse:
		[contextStackIndex > 1
			ifTrue: [interruptedProcess popTo: self selectedContext]
			ifFalse: [interruptedProcess install: self selectedContext].
		Smalltalk isMorphic
			ifTrue: [Project current resumeProcess: interruptedProcess]
			ifFalse: [ScheduledControllers
						activeControllerNoTerminate: interruptedController
						andProcess: interruptedProcess]].
	"if old process was terminated, just terminate current one"
	interruptedProcess _ nil. "Before delete, so release doesn't terminate it"
	Smalltalk isMorphic
		ifTrue: [aTopView delete. World displayWorld]
		ifFalse: [aTopView controller closeAndUnscheduleNoErase].
	Smalltalk installLowSpaceWatcher.  "restart low space handler"
	errorWasInUIProcess == false ifFalse: [Processor terminateActive].
! !


!Project methodsFor: 'active process' stamp: 'RAA 12/18/1999 15:34'!
spawnNewProcessIfNeeded

	world isMorph ifFalse: [self spawnNewProcess. ^true].	"does this ever happen?"
	world stillAlive: false.
	(Delay forSeconds: 1) wait.
	world stillAlive ifFalse: [self spawnNewProcess. ^true].
	^false		"i.e. no new process was spawned"
	
	! !


!QT commentStamp: 'RAA 12/18/1999 15:46' prior: 0!
to test getting an error in a non-ui process,

- evaluate (QT begin)		"an inspector will open on a SharedQueue"

in the inspector eval pane, do:
- evaluate (self nextPut: 1) 	"the forked process will read the queue and beep"
- evaluate (self nextPut: nil) 	"the forked process will read the queue, beep and halt"
- hit proceed on the debugger

IF the debugger fix is in, you can proceed to:

- evaluate (self nextPut: 0) 	"the forked process will read the queue, beep and exit"

IF the debugger fix is NOT in, you will have lost the UI at this point. Use cmd/alt-period to interrupt the other process.
!

!QT class methodsFor: 'as yet unclassified' stamp: 'RAA 12/18/1999 15:43'!
begin
"
QT begin
"
	| x |
	Q _ SharedQueue new.
	[
		[x _ Q next. 1 beep. x ifNil: [self halt]. x = 0] whileFalse.
		
	] forkAt: 5.
	Q inspect.

! !





More information about the Squeak-dev mailing list