[Vm-dev] VM Maker: Cog-eem.196.mcz

[commits at source.squeak.org]

Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.196.mcz

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

Name: Cog-eem.196
Author: eem
Time: 23 August 2014, 12:43:18.227 pm
UUID: ba7c10a8-52bd-4a00-9b14-80de8a855f2c
Ancestors: Cog-eem.195

Fix the <remove> code.  There need to be two enumerators
of selectoeas, one including the removed, and excluding them.

=============== Diff against Cog-eem.195 ===============

Item was added:
+ ----- Method: SpurBootstrap>>allPrototypeMethodSelectors (in category 'method prototypes') -----
+ allPrototypeMethodSelectors
+ 	"Answer all prototype selectors except those marked <remove>"
+ 	^(imageTypes
+ 		inject: (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes')
+ 		into: [:prototypes :type|
+ 				prototypes, (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes ', type)]) reject:
+ 			[:sel| ((SpurBootstrap class >> sel) pragmaAt: #remove) notNil]!

Item was removed:
- ----- Method: SpurBootstrap>>allPrototypeMethods (in category 'method prototypes') -----
- allPrototypeMethods
- 	^(imageTypes
- 		inject: (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes')
- 		into: [:prototypes :type|
- 				prototypes, (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes ', type)]) reject:
- 			[:sel| ((SpurBootstrap class >> sel) pragmaAt: #remove) notNil]!

Item was added:
+ ----- Method: SpurBootstrap>>allPrototypeSelectors (in category 'method prototypes') -----
+ allPrototypeSelectors
+ 	"Answer all prototype selectors, including those marked <remove>"
+ 	^imageTypes
+ 		inject: (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes')
+ 		into: [:prototypes :type|
+ 				prototypes, (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes ', type)]!

Item was changed:
  ----- Method: SpurBootstrap>>prototypeClassNameMetaSelectorMethodDo: (in category 'method prototypes') -----
  prototypeClassNameMetaSelectorMethodDo: quaternaryBlock
  	"Evaluate aBlock with class name, class is meta, method and selector.
  	 For now find methods in class-side category #'method prototypes'.
  	 Scheme could be extended to have different protocols for different
  	 Squeak/Pharo versions."
+ 	self allPrototypeMethodSelectors do:
- 	self allPrototypeMethods do:
  		[:protoSelector| | method className isMeta |
  		method := SpurBootstrap class >> protoSelector.
  		className := self classNameForPrototypeMethod: method.
  		(isMeta := className endsWith: 'class') ifTrue:
  			[className := (className allButLast: 5) asSymbol].
  		(method pragmaAt: #indirect) ifNotNil:
  			[method := (isMeta
  							ifTrue: [(Smalltalk classNamed: className) class]
  							ifFalse: [Smalltalk classNamed: className]) >> protoSelector].
  		quaternaryBlock
  			value: className
  			value: isMeta
  			value: (self selectorForPrototypeMethod: method)
  			value: method]!

Item was added:
+ ----- Method: SpurBootstrap>>removalClassNameMetaSelectorDo: (in category 'method prototypes') -----
+ removalClassNameMetaSelectorDo: quaternaryBlock
+ 	"Evaluate aBlock with class name, class is meta, and selector for
+ 	 all prototypes marked <remove>."
+ 	self allPrototypeSelectors do:
+ 		[:protoSelector| | method className isMeta |
+ 		method := SpurBootstrap class >> protoSelector.
+ 		className := self classNameForPrototypeMethod: method.
+ 		(isMeta := className endsWith: 'class') ifTrue:
+ 			[className := (className allButLast: 5) asSymbol].
+ 		(method pragmaAt: #remove) ifNotNil:
+ 			[quaternaryBlock
+ 				value: className
+ 				value: isMeta
+ 				value: (self selectorForPrototypeMethod: method)]]!

Item was changed:
  ----- Method: SpurBootstrap>>removeMethods (in category 'bootstrap methods') -----
  removeMethods
  	"Get the simulator to remove any methods marked with <remove>."
  	| removeSym |
  	removeSym := self findSymbol: #removeSelectorSilently:.
  	removeSym ifNil:
  		[removeSym := self findSymbol: #removeSelector:].
+ 	self removalClassNameMetaSelectorDo:
+ 		[:className :isMeta :selector| | class |
+ 		(self findClassNamed: (literalMap at: className)) ifNotNil:
+ 			[:theClass|
+ 			 class := isMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass].
+ 			 Transcript
+ 				cr;
+ 				nextPutAll: 'removing ';
+ 				nextPutAll: className;
+ 				nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
+ 				store: selector;
+ 				flush.
+ 			 self interpreter: oldInterpreter
+ 				object: class
+ 				perform: removeSym
+ 				withArguments: {literalMap at: selector}]]!
- 	self prototypeClassNameMetaSelectorMethodDo:
- 		[:className :isMeta :selector :method| | class |
- 		(method pragmaAt: #remove) ifNotNil:
- 			[(self findClassNamed: (literalMap at: className)) ifNotNil:
- 				[:theClass|
- 				 class := isMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass].
- 				 self interpreter: oldInterpreter
- 					object: class
- 					perform: removeSym
- 					withArguments: {literalMap at: selector}]]]!