[Pkg] The Trunk: Kernel-ar.333.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Dec 22 11:50:12 UTC 2009


Andreas Raab uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-ar.333.mcz

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

Name: Kernel-ar.333
Author: ar
Time: 22 December 2009, 12:49:25 pm
UUID: c8dddbe1-8097-114b-bed9-c8053064e62d
Ancestors: Kernel-ar.332

CompiledMethodTrailer phase 2.

=============== Diff against Kernel-ar.332 ===============

Item was changed:
  ----- Method: CompiledMethod>>copyWithTempNames: (in category 'source code management') -----
  copyWithTempNames: tempNames
  	"Minimal temp name copy that only works for methods containing no temporaries or blocks with arguments.
  	Used by the Traits system for creating conflict and required methdos that generate warnings.
  	For generic use use copyWithTempsFromMethodNode:"
  	| tempString |
  	tempString := String streamContents:
  					[:str|
  					tempNames
  						do: [:temp| str nextPutAll: temp]
  						separatedBy: [str space].
  					str space].
+ 	^self copyWithTrailerBytes: (CompiledMethodTrailer new tempNames: tempString)				
+ !
- 	^self copyWithTrailerBytes: (self qCompress: tempString)!

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 |
- 	| largeBit primBits method 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 ].
  
- 	method := self newMethod: numberOfBytes + trailer size
- 		header: (nArgs bitShift: 24) +
- 				(nTemps bitShift: 18) +
- 				(largeBit bitShift: 17) +
- 				(nLits bitShift: 9) +
- 				primBits +
- 				(flagBit bitShift: 29).
- 
  	"Copy the source code trailer to the end"
+ 	^ trailer createMethod: numberOfBytes
+ 		header: (nArgs bitShift: 24) +
+ 				(nTemps bitShift: 18) +
+ 				(largeBit bitShift: 17) +
+ 				(nLits bitShift: 9) +
+ 				primBits +
+ 				(flagBit bitShift: 29).
+ 
+ !
- 	1 to: trailer size do:
- 		[:i | method at: method size - trailer size + i put: (trailer at: i)].
- 
- 	^ method!

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 |
- 	| largeBit primBits method |
  	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
+ 		 header: (nArgs bitShift: 24) +
- 	method := self newMethod: numberOfBytes + trailer size
- 		header: (nArgs bitShift: 24) +
  				(nTemps bitShift: 18) +
  				(largeBit bitShift: 17) +
  				(nLits bitShift: 9) +
  				primBits.
+ !
- 	1 to: trailer size do:  "Copy the source code trailer to the end"
- 		[:i | method at: method size - trailer size + i put: (trailer at: i)].
- 	^ method!

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

Item was changed:
  ----- Method: CompiledMethod class>>toReturnSelf (in category 'instance creation') -----
  toReturnSelf
  	"Answer an instance of me that is a quick return of the instance (^self)."
  
+ 	^ self toReturnSelfTrailerBytes: CompiledMethodTrailer empty!
- 	^ self toReturnSelfTrailerBytes: #(0 0 0 0)!

Item was changed:
  ----- Method: CompiledMethod>>copyWithTempsFromMethodNode: (in category 'source code management') -----
  copyWithTempsFromMethodNode: aMethodNode
+ 	^self copyWithTrailerBytes: (
+ 		CompiledMethodTrailer new tempNames: aMethodNode schematicTempNamesString)!
- 	^self copyWithTrailerBytes: (self qCompress: aMethodNode schematicTempNamesString)!



More information about the Packages mailing list