[squeak-dev] The Inbox: Tools-cbr.497.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Sep 18 01:52:35 UTC 2013


A new version of Tools was added to project The Inbox:
http://source.squeak.org/inbox/Tools-cbr.497.mcz

==================== Summary ====================

Name: Tools-cbr.497
Author: cbr
Time: 17 September 2013, 6:52:12.186 pm
UUID: c96decf0-66e6-414a-abb7-e2b351c7c0bb
Ancestors: Tools-fbs.496

As requested, Bob Arning's debugger experiments to the inbox repo. Based on debugfixpc.37.cs.

=============== Diff against Tools-fbs.496 ===============

Item was changed:
  CodeHolder subclass: #Debugger
+ 	instanceVariableNames: 'interruptedProcess interruptedController contextStack contextStackIndex contextStackList receiverInspector contextVariablesInspector externalInterrupt proceedValue selectingPC savedCursor isolationHead failedProject errorWasInUIProcess labelString message untilExpression detailsMorph newVarMorph'
+ 	classVariableNames: 'BobsWay ContextStackKeystrokes ErrorRecursion InterruptUIProcessIfBlockedOnErrorInBackgroundProcess'
- 	instanceVariableNames: 'interruptedProcess interruptedController contextStack contextStackIndex contextStackList receiverInspector contextVariablesInspector externalInterrupt proceedValue selectingPC savedCursor isolationHead failedProject errorWasInUIProcess labelString message untilExpression'
- 	classVariableNames: 'ContextStackKeystrokes ErrorRecursion InterruptUIProcessIfBlockedOnErrorInBackgroundProcess'
  	poolDictionaries: ''
  	category: 'Tools-Debugger'!
  
  !Debugger commentStamp: '<historical>' prior: 0!
  I represent the machine state at the time of an interrupted process. I also represent a query path into the state of the process. The debugger is typically viewed through a window that views the stack of suspended contexts, the code for, and execution point in, the currently selected message, and inspectors on both the receiver of the currently selected message, and the variables in the current context.
  
  Special note on recursive errors:
  Some errors affect Squeak's ability to present a debugger.  This is normally an unrecoverable situation.  However, if such an error occurs in an isolation layer, Squeak will attempt to exit from the isolation layer and then present a debugger.  Here is the chain of events in such a recovery.
  
  	* A recursive error is detected.
  	* The current project is queried for an isolationHead
  	* Changes in the isolationHead are revoked
  	* The parent project of isolated project is returned to
  	* The debugger is opened there and execution resumes.
  
  If the user closes that debugger, execution continues in the outer project and layer.  If, after repairing some damage, the user proceeds from the debugger, then the isolationHead is re-invoked, the failed project is re-entered, and execution resumes in that world. !

Item was added:
+ ----- Method: Debugger class>>bobsWay (in category 'private') -----
+ bobsWay
+ 
+ 	^BobsWay ifNil: [false]!

Item was added:
+ ----- Method: Debugger class>>bobsWay: (in category 'private') -----
+ bobsWay: b
+ 
+ 	BobsWay _ b.
+ 	DebuggerMethodMap initialize.!

Item was added:
+ ----- Method: Debugger class>>test001 (in category 'private') -----
+ test001
+ "
+ Debugger bobsWay: true; test001
+ Debugger bobsWay: false; test001
+ "
+  	self halt.
+ 	1 = 1 ifFalse: [self foo].
+ 	1 = 2 ifFalse: [self class].
+ 	self ifNotNil: [3+4].!

Item was added:
+ ----- Method: Debugger class>>test002 (in category 'private') -----
+ test002
+ "
+ Debugger bobsWay: true; test002
+ Debugger bobsWay: false; test002
+ "
+  	self halt.
+ 	1 to: 'abc' size do: [ :i | i + i].!

Item was added:
+ ----- Method: Debugger class>>test003 (in category 'private') -----
+ test003
+ "
+ Debugger bobsWay: true; test003
+ Debugger bobsWay: false; test003
+ "
+  	self halt.
+ 	AlignmentMorph new.
+ 	SystemWindow new.
+ 	OrderedCollection withAll: #(1 2 9 8)!

Item was added:
+ ----- Method: Debugger>>betterHints (in category 'as yet unclassified') -----
+ betterHints
+ 
+ 	| c scanner detector newSel oldSel |
+ 	
+ 	c _ self selectedContext ifNil: [^self].
+ 	scanner _ InstructionStream new method: c method pc: c pc.
+ 	detector _ VariableChangeDetector new notify: [ :type :offset |
+ 			"Transcript show: {offset. type. contextVariablesInspector selectionIndex} asString; cr."
+ 		(type = #storeIntoTemporaryVariable: or: [type = #popIntoTemporaryVariable:]) ifTrue: [
+ 			oldSel _ contextVariablesInspector selectionIndex.
+ 			newSel _ offset + 3.
+ 			oldSel = newSel ifFalse: [
+ 				contextVariablesInspector toggleIndex: newSel
+ 			].
+ 		].
+ 		(type = #storeIntoReceiverVariable: or: [type = #popIntoReceiverVariable:]) ifTrue: [
+ 			oldSel _ receiverInspector selectionIndex.
+ 			newSel _ offset + 2.
+ 			oldSel = newSel ifFalse: [
+ 				receiverInspector toggleIndex: newSel
+ 			].
+ 		].
+ 	].
+ 	scanner interpretNextInstructionFor: detector.!

Item was changed:
  ----- Method: Debugger>>buildFullWith: (in category 'toolbuilder') -----
  buildFullWith: builder
  	| windowSpec listSpec textSpec extent |
+ 	
+ 	Debugger bobsWay ifTrue: [^self buildFullWithBobsWay: builder].
+ 	
  	windowSpec := builder pluggableWindowSpec new.
  	windowSpec model: self.
  	windowSpec label: 'Debugger'.
  	Display height < 800 "a small screen" 
  		ifTrue:[extent := RealEstateAgent standardWindowExtent]
  		ifFalse:[extent := 600 at 700].
  	windowSpec extent: extent.
  	windowSpec children: OrderedCollection new.
  
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #contextStackList; 
  		getIndex: #contextStackIndex; 
  		setIndex: #toggleContextStackIndex:; 
  		menu: #contextStackMenu:shifted:; 
  		keyPress: #contextStackKey:from:;
  		frame: (0 at 0 corner: 1 at 0.22).
  	windowSpec children add: listSpec.
  
  
  	textSpec := self buildCodePaneWith: builder.
  	textSpec frame: (0 at 0.22corner: 1 at 0.8).
  	windowSpec children add: textSpec.
  
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self receiverInspector;
  		list: #fieldList; 
  		getIndex: #selectionIndex; 
  		setIndex: #toggleIndex:; 
  		menu: #fieldListMenu:; 
  		keyPress: #inspectorKey:from:;
  		frame: (0 at 0.8 corner: 0.2 at 1).
  	windowSpec children add: listSpec.
  
  	textSpec := builder pluggableTextSpec new.
  	textSpec 
  		model: self receiverInspector;
  		getText: #contents; 
  		setText: #accept:; 
  		selection: #contentsSelection; 
  		menu: #codePaneMenu:shifted:;
  		frame: (0.2 at 0.8 corner: 0.5 at 1).
  	windowSpec children add: textSpec.
  
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self contextVariablesInspector;
  		list: #fieldList; 
  		getIndex: #selectionIndex; 
  		setIndex: #toggleIndex:; 
  		menu: #fieldListMenu:; 
  		keyPress: #inspectorKey:from:;
  		frame: (0.5 at 0.8 corner: 0.7 at 1).
  	windowSpec children add: listSpec.
  
  	textSpec := builder pluggableTextSpec new.
  	textSpec 
  		model: self contextVariablesInspector;
  		getText: #contents; 
  		setText: #accept:; 
  		selection: #contentsSelection; 
  		menu: #codePaneMenu:shifted:;
  		frame: (0.7 at 0.8 corner: 1 at 1).
  	windowSpec children add: textSpec.
  
  	^builder build: windowSpec!

Item was added:
+ ----- Method: Debugger>>buildFullWithBobsWay: (in category 'toolbuilder') -----
+ buildFullWithBobsWay: builder
+ 
+ 	| windowSpec listSpec textSpec extent detailsSpec myOffset vertSplit newvarSpec pane |
+ 	
+ 	windowSpec := builder pluggableWindowSpec new.
+ 	windowSpec model: self.
+ 	windowSpec label: 'Debugger'.
+ 	Display height < 800 "a small screen" 
+ 		ifTrue:[extent := RealEstateAgent standardWindowExtent]
+ 		ifFalse:[extent := 1000 at 700].
+ 	windowSpec extent: extent.
+ 	windowSpec children: OrderedCollection new.
+ 
+ 	vertSplit _ 0.6.
+ 	
+ 	listSpec := builder pluggableListSpec new.
+ 	listSpec 
+ 		model: self;
+ 		list: #contextStackList; 
+ 		getIndex: #contextStackIndex; 
+ 		setIndex: #toggleContextStackIndex:; 
+ 		menu: #contextStackMenu:shifted:; 
+ 		keyPress: #contextStackKey:from:;
+ 		frame: (0 at 0 corner: vertSplit at 0.22).
+ 	windowSpec children add: listSpec.
+ 
+ 	Debugger bobsWay ifTrue: [
+ 		myOffset _ TextStyle defaultFont height+4.
+ 		detailsSpec := AnyMorphSpec new.
+ 		detailsSpec 
+ 			makerBlock: [detailsMorph _ StringMorph new color: Color blue];
+ 			model: self;
+ 			frame: (LayoutFrame new
+ 				leftFraction: 0 offset: 0;
+ 				topFraction: 0.22 offset: 0;
+ 				rightFraction: vertSplit offset: 0;
+ 				bottomFraction: 0.22 offset: myOffset
+ 			).
+ 		windowSpec children add: detailsSpec.
+ 
+ 		textSpec := self buildCodePaneWith: builder.
+ 		textSpec frame: (LayoutFrame new
+ 				leftFraction: 0 offset: 0;
+ 				topFraction: 0.22 offset: myOffset;
+ 				rightFraction: vertSplit offset: 0;
+ 				bottomFraction: 1 offset: 0
+ 		).
+ 		windowSpec children add: textSpec.
+ 	].
+ 
+ 				"listSpec := builder pluggableListSpec new.
+ 				listSpec 
+ 					model: self receiverInspector;
+ 					list: #fieldList; 
+ 					getIndex: #selectionIndex; 
+ 					setIndex: #toggleIndex:; 
+ 					menu: #fieldListMenu:; 
+ 					keyPress: #inspectorKey:from:;
+ 					frame: (0 at 0.8 corner: (0.2*vertSplit)@1).
+ 				windowSpec children add: listSpec.
+ 
+ 				textSpec := builder pluggableTextSpec new.
+ 				textSpec 
+ 					model: self receiverInspector;
+ 					getText: #contents; 
+ 					setText: #accept:; 
+ 					selection: #contentsSelection; 
+ 					menu: #codePaneMenu:shifted:;
+ 					frame: ((0.2*vertSplit)@0.8 corner: (0.5*vertSplit)@1).
+ 				windowSpec children add: textSpec.
+ 
+ 				listSpec := builder pluggableListSpec new.
+ 				listSpec 
+ 					model: self contextVariablesInspector;
+ 					list: #fieldList; 
+ 					getIndex: #selectionIndex; 
+ 					setIndex: #toggleIndex:; 
+ 					menu: #fieldListMenu:; 
+ 					keyPress: #inspectorKey:from:;
+ 					frame: ((0.5*vertSplit)@0.8 corner: (0.7*vertSplit)@1).
+ 				windowSpec children add: listSpec.
+ 
+ 				textSpec := builder pluggableTextSpec new.
+ 				textSpec 
+ 					model: self contextVariablesInspector;
+ 					getText: #contents; 
+ 					setText: #accept:; 
+ 					selection: #contentsSelection; 
+ 					menu: #codePaneMenu:shifted:;
+ 					frame: ((0.7*vertSplit)@0.8 corner: vertSplit at 1).
+ 				windowSpec children add: textSpec."
+ 
+ 	newvarSpec := AnyMorphSpec new.
+ 	newvarSpec 
+ 		makerBlock: [
+ 			pane _ (newVarMorph _ DebuggerVariablesMorph new)
+ 				width: 1000;
+ 				inABobsScrollPane.	"will let scroll by trackpad work"
+ 			pane color: Color white.
+ 		];
+ 		model: self;
+ 		frame: (LayoutFrame new
+ 			leftFraction: vertSplit offset: 0;
+ 			topFraction: 0 offset: 0;
+ 			rightFraction: 1 offset: 0;
+ 			bottomFraction: 1 offset: 0
+ 		).
+ 	windowSpec children add: newvarSpec.
+ 
+ 	^builder build: windowSpec!

Item was added:
+ ----- Method: Debugger>>changed: (in category 'as yet unclassified') -----
+ changed: x
+ 
+ 	super changed: x.
+ 	(x = #contentsSelection or: [x = #contextStackIndex]) ifTrue: [
+ 		detailsMorph ifNotNil: [detailsMorph contents: self debugDetails].
+ 		newVarMorph ifNotNil: [
+ 			newVarMorph 
+ 				targetReceiver: self receiver;
+ 				targetContext: self selectedContext;
+ 				step].
+ 	]
+ !

Item was changed:
  ----- Method: Debugger>>codePaneMenu:shifted: (in category 'code pane menu') -----
  codePaneMenu: aMenu shifted: shifted
+ 
+ 	Debugger bobsWay ifTrue: [
+ 		self selectedContext ifNotNil: [ :c |
+ 			aMenu
+ 				add: c explainPC
+ 				target: [c debuggerMap explore] 
+ 				selector: #value;
+ 				
+ 				addLine.
+ 		].
+ 	].
+ 
  	aMenu
  		add: 'run to here' target: self selector: #runToSelection: argument: thisContext sender receiver selectionInterval;
  		add: 'run until...' target: self selector: #runUntil;
  		addLine.
  	super codePaneMenu: aMenu shifted: shifted.
  	^aMenu.!

Item was added:
+ ----- Method: Debugger>>debugDetails (in category 'toolbuilder') -----
+ debugDetails
+ 
+ 	self selectedContext ifNil: [^''] ifNotNil: [ :c |
+ 		^c explainPC
+ 	].
+ !

Item was changed:
  ----- Method: Debugger>>doStep (in category 'context stack menu') -----
  doStep
  	"Send the selected message in the accessed method, and regain control 
  	after the invoked method returns."
  	
  	| currentContext newContext |
  	self okToChange ifFalse: [^ self].
  	self checkContextSelection.
+ 	
+ 	self betterHints.
+ 	
+ 	
  	currentContext := self selectedContext.
  	newContext := interruptedProcess completeStep: currentContext.
  	newContext == currentContext ifTrue: [
  		newContext := interruptedProcess stepToSendOrReturn].
  	self contextStackIndex > 1
  		ifTrue: [self resetContext: newContext]
  		ifFalse: [newContext == currentContext
  				ifTrue: [self changed: #contentsSelection.
  						self updateInspectors]
  				ifFalse: [self resetContext: newContext]].
  !

Item was changed:
  Object subclass: #DebuggerMethodMap
+ 	instanceVariableNames: 'timestamp methodReference methodNode abstractSourceRanges sortedSourceMap bobsList1 explanations'
- 	instanceVariableNames: 'timestamp methodReference methodNode abstractSourceRanges sortedSourceMap'
  	classVariableNames: 'AccessLock MapCache MapCacheEntries'
  	poolDictionaries: ''
  	category: 'Tools-Debugger'!
  
  !DebuggerMethodMap commentStamp: '<historical>' prior: 0!
  I am a place-holder for information needed by the Debugger to inspect method activations.  I insulate the debugger from details of code generation such as exact bytecode offsets and temporary variable locations.  I have two concreate subclasses, one for methods compiled using BlueBook blocks and one for methods compiled using Closures.  These classes deal with temporary variable access. My function is to abstract the source map away from actual bytecode pcs to abstract bytecode pcs.
  
  To reduce compilation time I try and defer as much computation to access time as possible as instances of me will be created after each compilation.
  
  I maintain a WeakIdentityDictionary of method to DebuggerMethodMap to cache maps.  I refer to my method through a WeakArray to keep the map cache functional. If the reference from a DebuggerMethodMap to its method were strong then the method would never be dropped from the cache because the reference from its map would keep it alive.!

Item was added:
+ ----- Method: DebuggerMethodMap>>explanationForPC: (in category 'source mapping') -----
+ explanationForPC: pc
+ 
+ 	self initializeLists.
+ 	explanations at: pc ifPresent: [ :exp | ^ exp].
+ 	^explanations at: pc put: [self method abstractBytecodeMessageAt: pc]
+ !

Item was added:
+ ----- Method: DebuggerMethodMap>>initializeLists (in category 'source mapping') -----
+ initializeLists
+ 
+ 	| ignores |
+ 	
+ 	sortedSourceMap ifNotNil: [^self].
+ 	
+ 	explanations _ Dictionary new.
+ 	ignores _ Set new.
+ 	sortedSourceMap _ SortedCollection new.
+ 	methodNode rawSourceRangesAndMethodDo: [ :rawSourceRanges :method | 
+ 		rawSourceRanges keysAndValuesDo: [ :node :range |
+ 			(node isMessageNode and: [node selector key = #to:by:do:]) ifTrue: [
+ 				{
+ 					4. [ :ctxt | 'setting loop variable=' ,ctxt safeTop asString].
+ 					5. ['testing loop variable'].
+ 					6. [ :ctxt | 'incrementing loop variable=' ,ctxt safeTop asString].
+ 					7. [ :ctxt | 'setting loop limit=' ,ctxt safeTop asString].
+ 				} pairsDo: [ :ax :expl | 
+ 					(node arguments at: ax) ifNotNilDo: [ :fakeNode |
+ 						ignores add: fakeNode.
+ 						explanations at: fakeNode pc put: expl.
+ 					].
+ 				].
+ 			]
+ 		].
+ 		rawSourceRanges keysAndValuesDo: [ :node :range |
+ 			(node pc ~= 0 and: [(ignores includes: node) not]) ifTrue: [	
+ 				sortedSourceMap add: node pc -> range.
+ 				explanations at: node pc put: [node asString].
+ 				node secondPC ifNotNil: [ :pc2 |
+ 					sortedSourceMap add: pc2 -> range.
+ 					explanations at: pc2 put: [node asString].
+ 				].
+ 			].
+ 		].
+ 	].
+ 
+ !

Item was changed:
  ----- Method: DebuggerMethodMap>>rangeForPC:contextIsActiveContext: (in category 'source mapping') -----
  rangeForPC: contextsConcretePC contextIsActiveContext: contextIsActiveContext
  	"Answer the indices in the source code for the supplied pc.
  	 If the context is the actve context (is at the hot end of the stack)
  	 then its pc is the current pc.  But if the context isn't, because it is
  	 suspended sending a message, then its current pc is the previous pc."
  
  	| pc i end |
+ 	
+ 	Debugger bobsWay ifTrue: [
+ 		^self rangeForPCBobsWayV2: contextsConcretePC contextIsActiveContext: contextIsActiveContext
+ 	].
+ 
  	pc := self method abstractPCForConcretePC: (contextIsActiveContext
  													ifTrue: [contextsConcretePC]
  													ifFalse: [(self method pcPreviousTo: contextsConcretePC)
  																ifNotNil: [:prevpc| prevpc]
  																ifNil: [contextsConcretePC]]).
  	(self abstractSourceMap includesKey: pc) ifTrue:
  		[^self abstractSourceMap at: pc].
  	sortedSourceMap ifNil:
  		[sortedSourceMap := self abstractSourceMap.
  		 sortedSourceMap := (sortedSourceMap keys collect: 
  								[:key| key -> (sortedSourceMap at: key)]) asSortedCollection].
  	(sortedSourceMap isNil or: [sortedSourceMap isEmpty]) ifTrue: [^1 to: 0].
  	i := sortedSourceMap findNearbyBinaryIndex: [:assoc| pc - assoc key].
  	i < 1 ifTrue: [^1 to: 0].
  	i > sortedSourceMap size ifTrue:
  		[end := sortedSourceMap inject: 0 into:
  			[:prev :this | prev max: this value last].
  		^end+1 to: end].
  	^(sortedSourceMap at: i) value
  
  	"| method source scanner map |
  	 method := DebuggerMethodMap compiledMethodAt: #rangeForPC:contextIsActiveContext:.
  	 source := method getSourceFromFile asString.
  	 scanner := InstructionStream on: method.
  	 map := method debuggerMap.
  	 Array streamContents:
  		[:ranges|
  		[scanner atEnd] whileFalse:
  			[| range |
  			 range := map rangeForPC: scanner pc contextIsActiveContext: true.
  			 ((map abstractSourceMap includesKey: scanner abstractPC)
  			  and: [range first ~= 0]) ifTrue:
  				[ranges nextPut: (source copyFrom: range first to: range last)].
  			scanner interpretNextInstructionFor: InstructionClient new]]"!

Item was added:
+ ----- Method: DebuggerMethodMap>>rangeForPCBobsWayV2:contextIsActiveContext: (in category 'source mapping') -----
+ rangeForPCBobsWayV2: contextsConcretePC contextIsActiveContext: contextIsActiveContext
+ 	"Answer the indices in the source code for the supplied pc.
+ 	 If the context is the actve context (is at the hot end of the stack)
+ 	 then its pc is the current pc.  But if the context isn't, because it is
+ 	 suspended sending a message, then its current pc is the previous pc."
+ 
+ 	| pc end |
+ 	
+ 	pc _ contextIsActiveContext ifTrue: [
+ 		contextsConcretePC
+ 	] ifFalse: [
+ 		(self method pcPreviousTo: contextsConcretePC) ifNotNil: [:prevpc| prevpc] ifNil: [contextsConcretePC]
+ 	].
+ 	self initializeLists.
+ 	
+ 		"(sortedSourceMap isEmpty or: [pc < sortedSourceMap first key]) ifTrue: [^1 to: 0]."
+ 	end _ 0.
+ 	sortedSourceMap do: [ :assoc |
+ 		end _ end max: assoc value last.
+ 		pc <= assoc key ifTrue: [^assoc value].
+ 	].
+ 	^end+1 to: end
+ 	
+ !



More information about the Squeak-dev mailing list