[Pkg] The Trunk: Kernel-eem.620.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Sep 16 00:15:26 UTC 2011


Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.620.mcz

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

Name: Kernel-eem.620
Author: eem
Time: 15 September 2011, 5:14:46.105 pm
UUID: fca45b03-707d-49a7-a9e6-e5e73dbb31d2
Ancestors: Kernel-eem.619

Kernel half of second part of changes to revive ability to
create subclasses of CompiledMethod.  Other half is
Compiler-eem.215.

Fix nasty bug with AdditionalMethodState copying.  It wasn't
copying the associations so properties would end up
shared between copies sicne the associations ended up
shared.

Add id hash to printing of AdditionalMethodState to make
reasoning about sharing easier.

=============== Diff against Kernel-eem.619 ===============

Item was added:
+ ----- Method: AdditionalMethodState>>postCopy (in category 'copying') -----
+ postCopy
+ 	"After copying we must duplicate any associations and pragmas so they don't end up being shared."
+ 	1 to: self basicSize do:
+ 		[:i| self basicAt: i put: (self basicAt: i) shallowCopy]!

Item was added:
+ ----- Method: AdditionalMethodState>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	super printOn: aStream.
+ 	aStream space; nextPut: $(; print: self identityHash; nextPut: $)!

Item was changed:
  ----- Method: CompiledMethod class>>newBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'instance creation') -----
  newBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
  	"Answer an instance of me. The header is specified by the message 
  	arguments. The remaining parts are not as yet determined."
  	| largeBit primBits |
  	nTemps > 63 ifTrue:
  		[^ self error: 'Cannot compile -- too many temporary variables'].	
  	nLits > 255 ifTrue:
  		[^ self error: 'Cannot compile -- too many literals variables'].	
  	largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0].
  	primBits := primitiveIndex <= 16r1FF
  		ifTrue: [primitiveIndex]
  		ifFalse: ["For now the high bit of primitive no. is in the 29th bit of header"
  				primitiveIndex > 16r3FF ifTrue: [self error: 'prim num too large'].
  				(primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19)].
  
+ 	^trailer
+ 		createMethod: numberOfBytes
+ 		class: self
+ 		header: (nArgs bitShift: 24) +
- 	^ trailer createMethod: numberOfBytes
- 		 header: (nArgs bitShift: 24) +
  				(nTemps bitShift: 18) +
  				(largeBit bitShift: 17) +
  				(nLits bitShift: 9) +
+ 				primBits!
- 				primBits.
- !

Item was changed:
  ----- Method: CompiledMethod class>>newBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'instance creation') -----
  newBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
  	"Answer an instance of me. The header is specified by the message 
  	arguments. The remaining parts are not as yet determined."
  	| largeBit primBits flagBit |
  	nTemps > 63 ifTrue:
  		[^ self error: 'Cannot compile -- too many temporary variables'].	
  	nLits > 255 ifTrue:
  		[^ self error: 'Cannot compile -- too many literals variables'].	
  	largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0].
  
  	"For now the high bit of the primitive no. is in a high bit of the header"
  	primBits := (primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19).
  
  	flagBit := flag ifTrue: [ 1 ] ifFalse: [ 0 ].
  
  	"Copy the source code trailer to the end"
+ 	^trailer
+ 		createMethod: numberOfBytes
+ 		class: self
- 	^ trailer createMethod: numberOfBytes
  		header: (nArgs bitShift: 24) +
  				(nTemps bitShift: 18) +
  				(largeBit bitShift: 17) +
  				(nLits bitShift: 9) +
  				primBits +
+ 				(flagBit bitShift: 29)!
- 				(flagBit bitShift: 29).
- 
- !

Item was changed:
  ----- Method: CompiledMethod>>copyWithTrailerBytes: (in category 'initialize-release') -----
  copyWithTrailerBytes: trailer
  "Testing:
  	(CompiledMethod compiledMethodAt: #copyWithTrailerBytes:)
  		tempNamesPut: 'copy end '
  "
+ 	| copy end start penultimateLiteral |
- 	| copy end start |
  	start := self initialPC.
  	end := self endPC.
+ 	copy := trailer createMethod: end - start + 1 class: self class header: self header.
- 	copy := trailer createMethod: end - start + 1 header: self header.
  	1 to: self numLiterals do: [:i | copy literalAt: i put: (self literalAt: i)].
+ 	(penultimateLiteral := self penultimateLiteral) isMethodProperties ifTrue:
+ 		[copy penultimateLiteral: (penultimateLiteral copy
+ 									setMethod: copy;
+ 									yourself)].
  	start to: end do: [:i | copy at: i put: (self at: i)].
+ 	^copy!
- 
- 	^ copy!

Item was changed:
  ----- Method: CompiledMethod>>properties (in category 'accessing') -----
  properties
  	"Answer the method properties of the receiver."
  	| propertiesOrSelector |
  	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
  		ifTrue: [propertiesOrSelector]
+ 		ifFalse: [self class methodPropertiesClass forMethod: self selector: propertiesOrSelector]!
- 		ifFalse: [AdditionalMethodState forMethod: self selector: propertiesOrSelector]!

Item was changed:
  ----- Method: CompiledMethod>>propertyValueAt:put: (in category 'accessing-pragmas & properties') -----
  propertyValueAt: propName put: propValue
  	"Set or add the property with key propName and value propValue.
  	 If the receiver does not yet have a method properties create one and replace
  	 the selector with it.  Otherwise, either relace propValue in the method properties
  	 or replace method properties with one containing the new property."
  	| propertiesOrSelector |
  	(propertiesOrSelector := self penultimateLiteral) isMethodProperties ifFalse:
+ 		[self penultimateLiteral: ((self class methodPropertiesClass
- 		[self penultimateLiteral: ((AdditionalMethodState
  									selector: propertiesOrSelector
  									with: (Association
  											key: propName asSymbol
  											value: propValue))
  									setMethod: self;
  									yourself).
  		^propValue].
  	(propertiesOrSelector includesProperty: propName) ifTrue:
  		[^propertiesOrSelector at: propName put: propValue].
  	self penultimateLiteral: (propertiesOrSelector
  								copyWith: (Association
  												key: propName asSymbol
  												value: propValue)).
  	^propValue!



More information about the Packages mailing list