[pypy-commit] lang-smalltalk storage-display-refactoring: Reverted changes file back to storage version. Accidentally committed.

anton_gulenko noreply at buildbot.pypy.org
Tue Jul 22 23:27:05 CEST 2014


Author: Anton Gulenko <anton.gulenko at googlemail.com>
Branch: storage-display-refactoring
Changeset: r937:123f68a9dffe
Date: 2014-07-22 21:37 +0200
http://bitbucket.org/pypy/lang-smalltalk/changeset/123f68a9dffe/

Log:	Reverted changes file back to storage version. Accidentally
	committed.

diff --git a/images/Squeak4.5-noBitBlt.changes b/images/Squeak4.5-noBitBlt.changes
--- a/images/Squeak4.5-noBitBlt.changes
+++ b/images/Squeak4.5-noBitBlt.changes
@@ -12622,6 +12622,13 @@
 		self insertNewNode.
 	]! !

----SNAPSHOT----{15 July 2014 . 6:10:56 pm} Squeak4.5-noBitBlt.image priorSource: 15894330!
 
-----QUIT/NOSAVE----{21 July 2014 . 7:09:22 pm} Squeak4.5-noBitBlt.image priorSource: 15894825!
-
-----QUIT----{21 July 2014 . 7:10:12 pm} Squeak4.5-noBitBlt.image priorSource: 15894825!

----STARTUP----{22 July 2014 . 10:55:07 am} as C:\Dev\lang-smalltalk\images\Squeak4.5-noBitBlt.image!


Smalltalk specialObjectsArray at:15!

(Smalltalk specialObjectsArray at:15) depth!
\ No newline at end of file
+----QUIT/NOSAVE----{21 July 2014 . 4:18:39 pm} Squeak4.5-noBitBlt.image priorSource: 15894825!

----STARTUP----{21 July 2014 . 6:19:06 pm} as C:\Dev\lang-smalltalk\images\Squeak4.5-noBitBlt.image!

!WeakMessageSend methodsFor: 'private' stamp: 'ag 7/21/2014 18:20' prior: 34321504!
withEnsuredReceiverAndArgumentsDo: aBlock otherwise: altBlock
	"Grab real references to receiver and arguments. If they still exist, evaluate aBlock."

	"Return if my receiver has gone away"
	| r a |
	r := self receiver.
	r ifNil: [ ^altBlock value ].

	"Make sure that my arguments haven't gone away"
	arguments ifNil: [ ^ altBlock value ].
	a := Array withAll: arguments.
	a with: shouldBeNil do: [ :arg :flag |
		arg ifNil: [ flag ifFalse: [ ^altBlock value ]]
	].

	^aBlock value: r value: a! !

----QUIT----{21 July 2014 . 6:20:43 pm} Squeak4.5-noBitBlt.image priorSource: 15894825!
+
+----QUIT/NOSAVE----{21 July 2014 . 4:21:36 pm} Squeak4.5-noBitBlt.image priorSource: 15895702!

----STARTUP----{21 July 2014 . 6:21:54 pm} as C:\Dev\lang-smalltalk\images\Squeak4.5-noBitBlt.image!

!WeakMessageSend methodsFor: 'comparing' stamp: 'ag 7/21/2014 18:22' prior: 33144463!
= anObject
	"Compare equal to equivalent MessageSend"
	^ anObject isMessageSend
		and: [self receiver == anObject receiver
		and: [selector == anObject selector
		and: [(Array withAll: self arguments) = (Array withAll: anObject arguments)]]]
! !
!WeakMessageSend methodsFor: 'private' stamp: 'ag 7/21/2014 18:23' prior: 49449636!
withEnsuredReceiverAndArgumentsDo: aBlock otherwise: altBlock
	"Grab real references to receiver and arguments. If they still exist, evaluate aBlock."

	"Return if my receiver has gone away"
	| r a |
	r := self receiver.
	r ifNil: [ ^altBlock value ].

	"Make sure that my arguments haven't gone away"
	a := Array withAll: self arguments.
	a with: shouldBeNil do: [ :arg :flag |
		arg ifNil: [ flag ifFalse: [ ^altBlock value ]]
	].

	^aBlock value: r value: a! !

----QUIT----{21 July 2014 . 6:23:49 pm} Squeak4.5-noBitBlt.image priorSource: 15895702!

----STARTUP----{21 July 2014 . 6:31:05 pm} as C:\Dev\lang-smalltalk\images\Squeak4.5-noBitBlt.image!

!WeakMessageSend methodsFor: 'accessing' stamp: 'ag 7/21/2014 18:31'!
shouldBeNil
	
	^ shouldBeNil ifNil: [ Array new ]! !
!WeakMessageSend methodsFor: 'private' stamp: 'ag 7/21/2014 18:31' prior: 33148869!
isAnyArgumentGarbage
	"Make sure that my arguments haven't gone away"
	arguments ifNotNil: [
		arguments with: self shouldBeNil do: [ :arg :flag |
			(flag not and: [arg isNil])
				ifTrue: [^true]
		]
	].
	^false
! !
!WeakMessageSend methodsFor: 'private' stamp: 'ag 7/21/2014 18:31' prior: 49450841!
withEnsuredReceiverAndArgumentsDo: aBlock otherwise: altBlock
	"Grab real references to receiver and arguments. If they still exist, evaluate aBlock."

	"Return if my receiver has gone away"
	| r a |
	r := self receiver.
	r ifNil: [ ^altBlock value ].

	"Make sure that my arguments haven't gone away"
	a := Array withAll: self arguments.
	a with: self shouldBeNil do: [ :arg :flag |
		arg ifNil: [ flag ifFalse: [ ^altBlock value ]]
	].

	^aBlock value: r value: a! !
!WeakMessageSend methodsFor: 'private' stamp: 'ag 7/21/2014 18:32' prior: 34360552!
withEnsuredReceiverAndArgumentsDo: aBlock withEnoughArguments: anArray otherwise: altBlock
	"call the selector with enough arguments from arguments and anArray"
	| r selfArgs enoughArgs |
	r := self receiver.
	r ifNil: [ ^altBlock value ].
	
	selfArgs := self arguments.
	selfArgs with: self shouldBeNil do: [ :arg :flag |
		arg ifNil: [ flag ifFalse: [ ^altBlock value ]]
	].

	enoughArgs := Array new: selector numArgs.
	enoughArgs replaceFrom: 1
		to: ( selfArgs size min: enoughArgs size)
		with: selfArgs
		startingAt: 1.
	enoughArgs size > selfArgs size ifTrue: [
		enoughArgs replaceFrom: selfArgs size + 1
			to: (selfArgs size + anArray size min: enoughArgs size)
			with: anArray
			startingAt: 1.
	].
	^aBlock value: r value: enoughArgs! !

----QUIT----{21 July 2014 . 6:32:32 pm} Squeak4.5-noBitBlt.image priorSource: 15896872!
+
+----STARTUP----{21 July 2014 . 4:32:52 pm} as C:\Dev\lang-smalltalk\images\Squeak4.5-noBitBlt.image!
+
+
+1+1!
+
+----QUIT/NOSAVE----{21 July 2014 . 4:33:15 pm} Squeak4.5-noBitBlt.image priorSource: 15898877!
\ No newline at end of file


More information about the pypy-commit mailing list