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

commits at source.squeak.org commits at source.squeak.org
Fri Mar 31 00:13:04 UTC 2017


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

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

Name: Kernel-eem.1079
Author: eem
Time: 30 March 2017, 5:12:50.577477 pm
UUID: 2c378b83-0ed9-4add-8a90-5169c20dd173
Ancestors: Kernel-eem.1078

Replace mention of MethodContext with Context in comments as appropriate.

Make isMethodContext accurate.
Nuke the bootstrapContext script now it's done its job.
Nuke the left-over UndefinedObject>>allSuperclassesDo: which clearly does /not/ need to be implemented :-)

=============== Diff against Kernel-eem.1078 ===============

Item was changed:
  ----- Method: Behavior>>elementSize (in category 'accessing instances and variables') -----
  elementSize
  	"Answer the size in bytes of an element in the receiver.  The formats are
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character)
  			8	= unused
  			9	= 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap)
  		12-15	= 16-bit indexable
  		16-23	= 8-bit indexable
  		24-31	= compiled methods (CompiledMethod)"
  	| instSpec |
  	instSpec := self instSpec.
  	instSpec < 9 ifTrue: [^Smalltalk wordSize].
  	instSpec >= 16 ifTrue: [^1].
  	instSpec >= 12 ifTrue: [^2].
  	instSpec >= 10 ifTrue: [^4].
  	^8!

Item was changed:
  ----- Method: Behavior>>instSpec (in category 'testing') -----
  instSpec
  	"Answer the instance specification part of the format that defines what kind of object
  	 an instance of the receiver is.  The formats are
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character)
  			8	= unused
  			9	= 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap)					(plus one odd bit, unused in 32-bits)
  		12-15	= 16-bit indexable							(plus two odd bits, one unused in 32-bits)
  		16-23	= 8-bit indexable							(plus three odd bits, one unused in 32-bits)
  		24-31	= compiled methods (CompiledMethod)	(plus three odd bits, one unused in 32-bits)
  	 Note that in the VM instances also have a 5 bit format field that relates to their class's format.
  	 Formats 11, 13-15, 17-23 & 25-31 are unused in classes but used in instances to define the
  	 number of elements missing up to the slot size.  For example, a 2-byte ByteString instance
  	 has format 18 in 32-bits, since its size is one 32-bit slot - 2 bytes ((18 bitAnd: 3) = 2), and
  	 22 in 64 bits, since its size is one 64-bit slot - 6 bytes ((22 bitAnd: 7) = 6)."
  	^(format bitShift: -16) bitAnd: 16r1F!

Item was changed:
  ----- Method: Behavior>>isBits (in category 'testing') -----
  isBits
  	"Answer whether the receiver contains just bits (not pointers).
  	 Above Cog Spur the class format is
  		<5 bits inst spec><16 bits inst size>
  	 where the 5-bit inst spec is
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character)
  			8	= unused
  			9	= 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap)
  		12-15	= 16-bit indexable
  		16-23	= 8-bit indexable
  		24-31	= compiled methods (CompiledMethod)"
  	^self instSpec >= 7!

Item was changed:
  ----- Method: Behavior>>isBytes (in category 'testing') -----
  isBytes
  	"Answer whether the receiver's instances have indexed 8-bit integer instance variables.
  	 Above Cog Spur the class format is
  		<5 bits inst spec><16 bits inst size>
  	 where the 5-bit inst spec is
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character)
  			8	= unused
  			9	= 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap)
  		12-15	= 16-bit indexable
  		16-23	= 8-bit indexable
  		24-31	= compiled methods (CompiledMethod)"
  	^self instSpec >= 16!

Item was changed:
  ----- Method: Behavior>>isLongs (in category 'testing') -----
  isLongs
  	"Answer whether the receiver's instances have indexed 64-bit integer instance variables.
  	 Above Cog Spur the class format is
  		<5 bits inst spec><16 bits inst size>
  	 where the 5-bit inst spec is
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character)
  			8	= unused
  			9	= 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap)
  		12-15	= 16-bit indexable
  		16-23	= 8-bit indexable
  		24-31	= compiled methods (CompiledMethod)"
  	^self instSpec = 9!

Item was changed:
  ----- Method: Behavior>>isShorts (in category 'testing') -----
  isShorts
  	"Answer whether the receiver's instances have indexed 16-bit integer instance variables.
  	 Above Cog Spur the class format is
  		<5 bits inst spec><16 bits inst size>
  	 where the 5-bit inst spec is
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character)
  			8	= unused
  			9	= 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap)
  		12-15	= 16-bit indexable
  		16-23	= 8-bit indexable
  		24-31	= compiled methods (CompiledMethod)"
  	^self instSpec = 12!

Item was changed:
  ----- Method: Behavior>>isVariable (in category 'testing') -----
  isVariable
  	"Answer whether the receiver has indexable variables.
  	 Above Cog Spur the class format is
  		<5 bits inst spec><16 bits inst size>
  	 where the 5-bit inst spec is
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character)
  			8	= unused
  			9	= 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap)
  		12-15	= 16-bit indexable
  		16-23	= 8-bit indexable
  		24-31	= compiled methods (CompiledMethod)"
  	| instSpec |
  	instSpec := self instSpec.
  	^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!

Item was changed:
  ----- Method: Behavior>>isWords (in category 'testing') -----
  isWords
  	"Answer whether the receiver's instances have indexed 32-bit integer instance variables.
  	 Above Cog Spur the class format is
  		<5 bits inst spec><16 bits inst size>
  	 where the 5-bit inst spec is
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character)
  			8	= unused
  			9	= 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap)
  		12-15	= 16-bit indexable
  		16-23	= 8-bit indexable
  		24-31	= compiled methods (CompiledMethod)"
  	^self instSpec = 10!

Item was changed:
  ----- Method: BlockClosure>>asContext (in category 'scheduling') -----
  asContext
+ 	"Create a Context that is ready to execute self.  Assumes self takes no args (if it does the args will be nil)"
- 	"Create a MethodContext that is ready to execute self.  Assumes self takes no args (if it does the args will be nil)"
  
  	^self asContextWithSender: nil!

Item was changed:
  ----- Method: BlockClosure>>value (in category 'evaluating') -----
  value
+ 	"Activate the receiver, creating a closure activation (Context)
- 	"Activate the receiver, creating a closure activation (MethodContext)
  	 whose closure is the receiver and whose caller is the sender of this
  	 message. Supply the copied values to the activation as its copied
  	 temps. Primitive. Essential."
  	<primitive: 201>
  	| newContext |
  	numArgs ~= 0 ifTrue:
  		[self numArgsError: 0].
  	false
  		ifTrue: "Old code to simulate the closure value primitive on VMs that lack it."
  			[newContext := self asContextWithSender: thisContext sender.
  			thisContext privSender: newContext]
  		ifFalse: [self primitiveFailed]!

Item was changed:
  ----- Method: BlockClosure>>value: (in category 'evaluating') -----
  value: firstArg
+ 	"Activate the receiver, creating a closure activation (Context)
- 	"Activate the receiver, creating a closure activation (MethodContext)
  	 whose closure is the receiver and whose caller is the sender of this
  	 message. Supply the argument and copied values to the activation
  	 as its argument and copied temps. Primitive. Essential."
  	<primitive: 202>
  	| newContext |
  	numArgs ~= 1 ifTrue:
  		[self numArgsError: 1].
  	false
  		ifTrue: "Old code to simulate the closure value primitive on VMs that lack it."
  			[newContext := self asContextWithSender: thisContext sender.
  			newContext at: 1 put: firstArg.
  			thisContext privSender: newContext]
  		ifFalse: [self primitiveFailed]!

Item was changed:
  ----- Method: BlockClosure>>value:value: (in category 'evaluating') -----
  value: firstArg value: secondArg
+ 	"Activate the receiver, creating a closure activation (Context)
- 	"Activate the receiver, creating a closure activation (MethodContext)
  	 whose closure is the receiver and whose caller is the sender of this
  	 message. Supply the arguments and copied values to the activation
  	 as its arguments and copied temps. Primitive. Essential."
  	<primitive: 203>
  	| newContext |
  	numArgs ~= 2 ifTrue:
  		[self numArgsError: 2].
  	false
  		ifTrue: "Old code to simulate the closure value primitive on VMs that lack it."
  			[newContext := self asContextWithSender: thisContext sender.
  			newContext at: 1 put: firstArg.
  			newContext at: 2 put: secondArg.
  			thisContext privSender: newContext]
  		ifFalse: [self primitiveFailed]!

Item was changed:
  ----- Method: BlockClosure>>value:value:value: (in category 'evaluating') -----
  value: firstArg value: secondArg value: thirdArg
+ 	"Activate the receiver, creating a closure activation (Context)
- 	"Activate the receiver, creating a closure activation (MethodContext)
  	 whose closure is the receiver and whose caller is the sender of this
  	 message. Supply the arguments and copied values to the activation
  	 as its arguments and copied temps. Primitive. Essential."
  	<primitive: 204>
  	| newContext |
  	numArgs ~= 3 ifTrue:
  		[self numArgsError: 3].
  	false
  		ifTrue: "Old code to simulate the closure value primitive on VMs that lack it."
  			[newContext := self asContextWithSender: thisContext sender.
  			newContext at: 1 put: firstArg.
  			newContext at: 2 put: secondArg.
  			newContext at: 3 put: thirdArg.
  			thisContext privSender: newContext]
  		ifFalse: [self primitiveFailed]!

Item was changed:
  ----- Method: BlockClosure>>value:value:value:value: (in category 'evaluating') -----
  value: firstArg value: secondArg value: thirdArg value: fourthArg
+ 	"Activate the receiver, creating a closure activation (Context)
- 	"Activate the receiver, creating a closure activation (MethodContext)
  	 whose closure is the receiver and whose caller is the sender of this
  	 message. Supply the arguments and copied values to the activation
  	 as its arguments and copied temps. Primitive. Essential."
  	<primitive: 205>
  	| newContext |
  	numArgs ~= 4 ifTrue:
  		[self numArgsError: 4].
  	false
  		ifTrue: "Old code to simulate the closure value primitive on VMs that lack it."
  			[newContext := self asContextWithSender: thisContext sender.
  			newContext at: 1 put: firstArg.
  			newContext at: 2 put: secondArg.
  			newContext at: 3 put: thirdArg.
  			newContext at: 4 put: fourthArg.
  			thisContext privSender: newContext]
  		ifFalse: [self primitiveFailed]!

Item was changed:
  ----- Method: BlockClosure>>valueWithArguments: (in category 'evaluating') -----
  valueWithArguments: anArray
+ 	"Activate the receiver, creating a closure activation (Context)
- 	"Activate the receiver, creating a closure activation (MethodContext)
  	 whose closure is the receiver and whose caller is the sender of this
  	 message. Supply the arguments in an anArray and copied values to
  	 the activation as its arguments and copied temps. Primitive. Essential."
  	<primitive: 206>
  	| newContext |
  	numArgs ~= anArray size ifTrue:
  		[self numArgsError: anArray size].
  	false
  		ifTrue: "Old code to simulate the closure value primitive on VMs that lack it."
  			[newContext := self asContextWithSender: thisContext sender.
  			1 to: numArgs do:
  				[:i| newContext at: i put: (anArray at: i)].
  			thisContext privSender: newContext]
  		ifFalse: [self primitiveFailed]!

Item was changed:
  ----- Method: ClassBuilder>>format:variable:bitsUnitSize:pointers:weak: (in category 'class format') -----
  format: nInstVars variable: isVar bitsUnitSize: bitsUnitSize pointers: isPointers weak: isWeak
  	"Compute the format for the given instance specfication.
  	 Above Cog Spur the class format is
  		<5 bits inst spec><16 bits inst size>
  	 where the 5-bit inst spec is
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character, SmallFloat64)
  			8	= unused
  			9	= 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap, WideString)
  		12-15	= 16-bit indexable
  		16-23	= 8-bit indexable (ByteString)
  		24-31	= compiled methods (CompiledMethod)"
  	| instSpec |
  	instSpec := isWeak
  					ifTrue:
  						[isVar
  							ifTrue: [4]
  							ifFalse: [5]]
  					ifFalse:
  						[isPointers
  							ifTrue:
  								[isVar
  									ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
  									ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
  							ifFalse:
  								[isVar
  									ifTrue: [bitsUnitSize caseOf: {
  											[1] -> [16].
  											[2] -> [12].
  											[4] -> [10].
  											[8] -> [9] }]
  									ifFalse: [7]]].
  	^(instSpec bitShift: 16) + nInstVars!

Item was changed:
  ----- Method: ClassBuilder>>format:variable:words:pointers:weak: (in category 'class format') -----
  format: nInstVars variable: isVar words: is32BitWords pointers: isPointers weak: isWeak
  	"Compute the format for the given instance specfication.
  	 Above Cog Spur the class format is
  		<5 bits inst spec><16 bits inst size>
  	 where the 5-bit inst spec is
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character)
  			8	= unused
  			9	= reserved for 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap)
  		12-15	= 16-bit indexable
  		16-23	= 8-bit indexable
  		24-31	= compiled methods (CompiledMethod)"
  	| instSpec |
  	instSpec := isWeak
  					ifTrue:
  						[isVar
  							ifTrue: [4]
  							ifFalse: [5]]
  					ifFalse:
  						[isPointers
  							ifTrue:
  								[isVar
  									ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
  									ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
  							ifFalse:
  								[isVar
  									ifTrue: [is32BitWords ifTrue: [10] ifFalse: [16]]
  									ifFalse: [7]]].
  	^(instSpec bitShift: 16) + nInstVars!

Item was changed:
  ----- Method: Context>>activateMethod:withArgs:receiver:class: (in category 'controlling') -----
  activateMethod: newMethod withArgs: args receiver: rcvr class: class 
+ 	"Answer a Context initialized with the arguments."
- 	"Answer a ContextPart initialized with the arguments."
  
  	^Context 
  		sender: self
  		receiver: rcvr
  		method: newMethod
  		arguments: args!

Item was changed:
  ----- Method: Context>>isMethodContext (in category 'testing') -----
  isMethodContext
+ 	^closureOrNil == nil!
- 	^ true!

Item was changed:
  ----- Method: Context>>pushArgs:from: (in category 'system simulation') -----
+ pushArgs: args "<Array>" from: sendr "<Context>" 
- pushArgs: args "<Array>" from: sendr "<ContextPart>" 
  	"Helps simulate action of the value primitive for closures.
  	 This is used by ContextPart>>runSimulated:contextAtEachStep:"
  
  	closureOrNil
  		ifNil: [self error: 'context needs a closure!!']
  		ifNotNil:
  			["See BlockClosure>>asContextWithSender:"
  			 stackp ~= (closureOrNil numArgs + closureOrNil numCopiedValues) ifTrue:
  				[self error: 'stack pointer is incorrect!!'].].
  
  	1 to: closureOrNil numArgs do:
  		[:i| self at: i put: (args at: i)].
  	sender := sendr!

Item was changed:
  ----- Method: Context>>receiver (in category 'accessing') -----
+ receiver
+ 	"Answer the receiver of the message that created this context."
- receiver 
- 	"Refer to the comment in ContextPart|receiver."
  
  	^receiver!

Item was removed:
- ----- Method: InstructionStream class>>bootstrapContext (in category 'bootstrap context') -----
- bootstrapContext
- 	"Rename MethodContext to Context."
- 	"InstructionStream bootstrapContext"
- 	thisContext class name = #Context ifTrue:
- 		[self assert: (Smalltalk classNamed: #MethodContext) == thisContext class.
- 		 self assert: (Smalltalk classNamed: #Context) == thisContext class.
- 		 ^self].
- 	MethodContext ensureClassPool.
- 	MethodContext classPool addAll: ContextPart classPool associations.
- 	MethodContext superclass: InstructionStream.
- 	MethodContext class superclass: InstructionStream class.
- 	InstructionStream addSubclass: MethodContext.
- 	MethodContext
- 		setInstVarNames: ContextPart instVarNames, MethodContext instVarNames;
- 		rename: #Context.
- 	Smalltalk at: #MethodContext ifAbsentPut: [Smalltalk classNamed: #Context].
- 	self assert: (Smalltalk classNamed: #MethodContext) == thisContext class.
- 	self assert: (Smalltalk classNamed: #Context) == thisContext class!

Item was changed:
  ----- Method: InstructionStream class>>instVarNamesAndOffsetsDo: (in category 'compiling') -----
  instVarNamesAndOffsetsDo: aBinaryBlock
  	"This is part of the interface between the compiler and a class's instance or field names.
  	 We override here to arrange that the compiler will use MaybeContextInstanceVariableNodes
+ 	 for instances variables of Context or any of its superclasses and subclasses.  The
- 	 for instances variables of ContextPart or any of its superclasses and subclasses.  The
  	 convention to make the compiler use the special nodes is to use negative indices"
  
  	| superInstSize |
  	(self withAllSubclasses noneSatisfy: [:class|class isContextClass]) ifTrue:
  		[^super instVarNamesAndOffsetsDo: aBinaryBlock].
  	(superInstSize := superclass notNil ifTrue: [superclass instSize] ifFalse: [0]) > 0 ifTrue:
  		[superclass instVarNamesAndOffsetsDo: aBinaryBlock].
  	1 to: self instSize - superInstSize do:
  		[:i| aBinaryBlock value: (instanceVariables at: i) value: (i + superInstSize) negated]!

Item was removed:
- ----- Method: UndefinedObject>>allSuperclassesDo: (in category 'class hierarchy') -----
- allSuperclassesDo: aBlockContext 
- 	self shouldBeImplemented!



More information about the Packages mailing list