[Vm-dev] We need help from VM experts. Re: Freeze after Morph Activity

Dan Norton dnorton at mindspring.com
Mon Feb 6 03:55:13 UTC 2017



On 02/05/2017 09:15 PM, David T. Lewis wrote:
>   
> On Sun, Feb 05, 2017 at 08:34:02PM -0500, David T. Lewis wrote:
>>   
>> On Sun, Feb 05, 2017 at 04:51:06PM -0500, Dan Norton wrote:
>>>   
>>> When the hang-up occurs, a #morphicStep is involved. I've never seen it
>>> otherwise.
>>>
>>> Attached is what may be the minimal test case: an empty step loop. File
>>> in the attachment and in a workspace do:
>>>
>>> Minish start
>>>
>>>   - Dan
>>
>> So far I have not been able to reproduce the hangup with the Minish example.
>> I've have about 20 of them open for about a half hour or so. Maybe it's just
>> really intermittent.
>>
> I ran for over an hour with the Minish morphs going, no problem. But I can
> get the image to hang in less than a minute by opening a bunch of bouncing
> Tokenish morphs.
Hi Dave,

You called it right: really intermittent with Minish. The first time I 
ran it, it hung in less than one minute - right after a print-it for 
"Time now print24" which I added to the workspace. But after that, I ran 
7 of them for hours with no hang.

Attached is a package of test cases I've been using to try to determine 
what does and does not hang - starting with Tokenish and down to Minish, 
each one taking something out of the loop.  Maybe something in there 
will be useful.

  - Dan
-------------- next part --------------
'From Cuis 5.0 of 7 November 2016 [latest update: #3043] on 5 February 2017 at 4:39:30 pm'!
'Description Please enter a description for this package'!
!provides: 'Freeze' 1 11!
!classDefinition: #Minish category: #Freeze!
EllipseMorph subclass: #Minish
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Freeze'!
!classDefinition: 'Minish class' category: #Freeze!
Minish class
	instanceVariableNames: ''!

!classDefinition: #Stepish category: #Freeze!
EllipseMorph subclass: #Stepish
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Freeze'!
!classDefinition: 'Stepish class' category: #Freeze!
Stepish class
	instanceVariableNames: ''!

!classDefinition: #Tokenish category: #Freeze!
EllipseMorph subclass: #Tokenish
	instanceVariableNames: ''
	classVariableNames: 'HopVComponent'
	poolDictionaries: ''
	category: 'Freeze'!
!classDefinition: 'Tokenish class' category: #Freeze!
Tokenish class
	instanceVariableNames: ''!

!classDefinition: #Wrapish category: #Freeze!
EllipseMorph subclass: #Wrapish
	instanceVariableNames: 'point'
	classVariableNames: 'HopVComponent'
	poolDictionaries: ''
	category: 'Freeze'!
!classDefinition: 'Wrapish class' category: #Freeze!
Wrapish class
	instanceVariableNames: ''!


!Minish commentStamp: '<historical>' prior: 0!
Example which experiences a freeze.!

!Stepish commentStamp: '<historical>' prior: 0!
Example which experiences a freeze.!

!Tokenish commentStamp: '<historical>' prior: 0!
A player's piece on the game board.!

!Wrapish commentStamp: '<historical>' prior: 0!
Example which experiences a freeze.!

!Minish methodsFor: 'stepping' stamp: 'dhn 2/5/2017 16:38:33'!
mini

	self when: #morphicStep evaluate: [ :a |].
	self startSteppingStepTime: 8. 	
! !

!Minish class methodsFor: 'instance creation' stamp: 'dhn 2/5/2017 16:37:16'!
start

	^ self new openInHand mini! !

!Stepish methodsFor: 'stepping' stamp: 'dhn 2/3/2017 14:36:41'!
jump
	"Just sit there and step"
	| step limit i |
	
	step _ 8.	"time of each increment of the hop"
	limit _ 50000001.
	Transcript 
		nextPutAll: 'Step = ';
		nextPutAll: step asString;
		nextPutAll: ', limit = ';
		nextPutAll: limit printStringWithCommas;
		nextPutAll: ', time = ';
		nextPutAll: Time now print24; newLine.
	i _ 0.
	self when: #morphicStep evaluate: [ :delta |
		i _ i + 1.
		i < limit 
			ifTrue: [(i mod: 100000) = 0 
				ifTrue: [
					Transcript 
						nextPutAll: i printStringWithCommas;
						nextPutAll: ' at ';
						nextPutAll: Time now print24; newLine]]
			ifFalse: [
				self stopStepping.
				self color: Color green.
				self removeActionsForEvent: #morphicStep]].
	self startSteppingStepTime: step. 	
! !

!Stepish methodsFor: 'stepping' stamp: 'dhn 2/3/2017 10:44:38'!
mini
	| limit i |
	
	limit := 50000001.
	i := 0.
	self when: #morphicStep evaluate: [ :unused |
		i := i + 1.
		i < limit 
			ifFalse: [
				self stopStepping.
				self color: Color green.
				self removeActionsForEvent: #morphicStep]].
	self startSteppingStepTime: 8. 	
! !

!Stepish class methodsFor: 'instance creation' stamp: 'dhn 2/3/2017 10:28:08'!
start

	^ self new openInHand jump! !

!Tokenish methodsFor: 'stepping' stamp: 'dhn 1/30/2017 18:07:59'!
jump
	"Make the receiver hop"
	| step limit i hop horiz |
	
	step _ 4.	"time of each increment of the hop"
	hop _ self class hopVComponent.
	limit _ 1000000. 	"hack"
	horiz _ 0. 	"hack"
	i _ 0.
	self when: #morphicStep evaluate: [ :delta |
		i _ i + 1.
		i < limit 
			ifTrue: [self morphPosition: (self morphPosition translatedBy: horiz@(hop atWrap: i))]
			ifFalse: [
				self stopStepping.
				self triggerEvent: #jumped.
				self removeActionsForEvent: #morphicStep]].
	self startSteppingStepTime: step. 	
! !

!Tokenish class methodsFor: 'operation' stamp: 'dhn 1/30/2017 17:53:15'!
hopVComponent
	"Answer the value of HopVComponent"
	
	HopVComponent ifNil: [HopVComponent _ self setupHop].
	^ HopVComponent! !

!Tokenish class methodsFor: 'instance creation' stamp: 'dhn 1/30/2017 17:53:15'!
setupHop
	"Answer the vertical component of a jump"
	| col up |
	
	up _ OrderedCollection new.
	col _ OrderedCollection new.
	0 to: 45 do: [:i | up add: ((i * 2) degreesToRadians cos * 2) negated].
	col _ col addAll: up; yourself.
	col _ col addAll: up reversed negated; yourself.
	^ col! !

!Tokenish class methodsFor: 'instance creation' stamp: 'dhn 2/3/2017 10:49:32'!
start

	^ self new openInHand jump! !

!Wrapish methodsFor: 'stepping' stamp: 'dhn 1/31/2017 18:33:02'!
jump
	"Just sit there and index,  occasionally wrapping"
	| step limit i hop |
	
	step _ 4.	"time of each increment of the hop"
	hop _ self class hopVComponent.
	limit _ 500001. 	"hack"
	i _ 0.
	self when: #morphicStep evaluate: [ :delta |
		i _ i + 1.
		i < limit 
			ifTrue: [
				point _ hop atWrap: i.
				(i mod: 100000) = 0 ifTrue: [{i} print]]
			ifFalse: [
				self stopStepping.
				self color: Color green.
				self removeActionsForEvent: #morphicStep]].
	self startSteppingStepTime: step. 	
! !

!Wrapish methodsFor: 'stepping' stamp: 'dhn 1/31/2017 16:58:41'!
spin
	"Never mind stepping - just haul"
	| limit hop horiz |
	
	hop _ self class hopVComponent.
	limit _ 100000000. 	"hack"
	horiz _ 0. 	"hack"
	1 to: limit do: [:i | 
		point _ horiz@(hop atWrap: i).
		(i mod: 1000000) = 0 ifTrue: [{i} print]]! !

!Wrapish class methodsFor: 'operation' stamp: 'dhn 1/31/2017 13:46:11'!
hopVComponent
	"Answer the value of HopVComponent"
	
	HopVComponent ifNil: [HopVComponent _ self setupHop].
	^ HopVComponent! !

!Wrapish class methodsFor: 'instance creation' stamp: 'dhn 1/31/2017 13:46:11'!
setupHop
	"Answer the vertical component of a jump"
	| col up |
	
	up _ OrderedCollection new.
	col _ OrderedCollection new.
	0 to: 45 do: [:i | up add: ((i * 2) degreesToRadians cos * 2) negated].
	col _ col addAll: up; yourself.
	col _ col addAll: up reversed negated; yourself.
	^ col! !

!Wrapish class methodsFor: 'instance creation' stamp: 'dhn 2/3/2017 10:49:45'!
start

	^ self new openInHand jump! !


More information about the Vm-dev mailing list