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

commits at source.squeak.org commits at source.squeak.org
Thu Mar 23 17:14:33 UTC 2017


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

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

Name: Kernel-eem.1068
Author: eem
Time: 23 March 2017, 10:12:09.692043 am
UUID: ee70e995-61c9-468a-8ff5-3238631c3710
Ancestors: Kernel-eem.1067

Add isCompiledCode to Object.  Later we can eliminate isCompiledMethod from Object if desired and implement isCompiledBlock and isCompiledMethod only on CompiledCode and subclasses.  In any case we need isCompiledCode in Object now more than we need isCompiledMethod.  Apologies to all offended by is methods (but get over it ;-) ).

Implement isCompiledBlock in CompiledCode (for subclasses of CompiledCode, foo isCompiledMethod = foo isCompiledBlock not).

Move the relevant class methods up from CompiledMethod to CompiledCode.  Redo the error messages in basicNew, new et al.

=============== Diff against Kernel-eem.1067 ===============

Item was added:
+ ----- Method: CompiledBlock>>isCompiledBlock (in category 'testing') -----
+ isCompiledBlock
+ 	^true!

Item was added:
+ ----- Method: CompiledCode class>>basicNew (in category 'instance creation') -----
+ basicNew
+ 	^self newMethodViaNewError!

Item was added:
+ ----- Method: CompiledCode class>>basicNew: (in category 'instance creation') -----
+ basicNew: size
+ 	^self newMethodViaNewError!

Item was added:
+ ----- Method: CompiledCode class>>fullFrameSize (in category 'constants') -----
+ fullFrameSize  "CompiledMethod fullFrameSize"
+ 	^ LargeFrame!

Item was added:
+ ----- Method: CompiledCode class>>handleFailingFailingNewMethod:header: (in category 'private') -----
+ handleFailingFailingNewMethod: numberOfBytes header: headerWord
+ 	"This newMethod:header: gets sent after handleFailingBasicNew: has done a full
+ 	 garbage collection and possibly grown memory.  If this basicNew: fails then the
+ 	 system really is low on space, so raise the OutOfMemory signal.
+ 
+ 	 Primitive. Answer an instance of this class with the number of indexable variables
+ 	 specified by the argument, headerWord, and the number of bytecodes specified
+ 	 by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
+ 	 is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
+ 	 memory available. Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 79>
+ 	"space must be low."
+ 	OutOfMemory signal.
+ 	"retry if user proceeds"
+ 	^self newMethod: numberOfBytes header: headerWord!

Item was added:
+ ----- Method: CompiledCode class>>handleFailingNewMethod:header: (in category 'private') -----
+ handleFailingNewMethod: numberOfBytes header: headerWord
+ 	"This newMethod:header: gets sent after newMethod:header: has failed
+ 	 and allowed a scavenging garbage collection to occur.  The scavenging
+ 	 collection will have happened as the VM is activating the (failing) basicNew:.
+ 	 If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
+ 	 space and a global garbage collection is required.  Retry after garbage
+ 	 collecting and growing memory if necessary.
+ 
+ 	 Primitive. Answer an instance of this class with the number of indexable variables
+ 	 specified by the argument, headerWord, and the number of bytecodes specified
+ 	 by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
+ 	 is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
+ 	 memory available. Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 79>
+ 	| bytesRequested |
+ 	bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16.
+ 	Smalltalk garbageCollect < bytesRequested ifTrue:
+ 		[Smalltalk growMemoryByAtLeast: bytesRequested].
+ 	"retry after global garbage collect and possible grow"
+ 	^self handleFailingFailingNewMethod: numberOfBytes header: headerWord!

Item was added:
+ ----- Method: CompiledCode class>>headerFlagForEncoder: (in category 'method encoding') -----
+ headerFlagForEncoder: anEncoder
+ 	anEncoder class == PrimaryBytecodeSetEncoderClass ifTrue:
+ 		[^0].
+ 	anEncoder class == SecondaryBytecodeSetEncoderClass ifTrue:
+ 		[^SmallInteger minVal].
+ 	self error: 'The encoder is not one of the two installed bytecode sets'!

Item was added:
+ ----- Method: CompiledCode class>>initialize (in category 'class initialization') -----
+ initialize    "CompiledMethod initialize"
+ 	"Initialize class variables specifying the size of the temporary frame
+ 	needed to run instances of me."
+ 
+ 	SmallFrame := 16.	"Context range for temps+stack"
+ 	LargeFrame := 56.
+ 	PrimaryBytecodeSetEncoderClass ifNil:
+ 		[PrimaryBytecodeSetEncoderClass := EncoderForV3PlusClosures].
+ 	SecondaryBytecodeSetEncoderClass ifNil:
+ 		[SecondaryBytecodeSetEncoderClass := EncoderForV3PlusClosures]!

Item was added:
+ ----- Method: CompiledCode class>>installPrimaryBytecodeSet: (in category 'class initialization') -----
+ installPrimaryBytecodeSet: aBytecodeEncoderSubclass
+ 	PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue:
+ 		[^self].
+ 	(aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse:
+ 		[self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder'].
+ 	(self allSubInstances
+ 			detect: [:m| m header >= 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]]
+ 			ifNone: []) ifNotNil:
+ 		[Warning signal: 'There are existing CompiledMethods with a different encoderClass.'].
+ 	PrimaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass!

Item was added:
+ ----- Method: CompiledCode class>>installSecondaryBytecodeSet: (in category 'class initialization') -----
+ installSecondaryBytecodeSet: aBytecodeEncoderSubclass
+ 	PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue:
+ 		[^self].
+ 	(aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse:
+ 		[self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder'].
+ 	(self allSubInstances
+ 			detect: [:m| m header < 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]]
+ 			ifNone: []) ifNotNil:
+ 		[Warning signal: 'There are existing CompiledMethods with a different encoderClass.'].
+ 	SecondaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass!

Item was added:
+ ----- Method: CompiledCode class>>maxNumLiterals (in category 'constants') -----
+ maxNumLiterals
+ 	"The current header format and the VM's interpretation of it allows for a maximum of 32767 literals."
+ 	^32767!

Item was added:
+ ----- Method: CompiledCode class>>new (in category 'instance creation') -----
+ new
+ 	^self newMethodViaNewError!

Item was added:
+ ----- Method: CompiledCode class>>new: (in category 'instance creation') -----
+ new: size
+ 	^self newMethodViaNewError!

Item was added:
+ ----- Method: CompiledCode 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."
+ 	| method pc |
+ 	nArgs > 15 ifTrue:
+ 		[^self error: 'Cannot compile -- too many arguments'].
+ 	nTemps > 63 ifTrue:
+ 		[^self error: 'Cannot compile -- too many temporary variables'].	
+ 	nLits > 32767 ifTrue:
+ 		[^self error: 'Cannot compile -- too many literals'].
+ 
+ 	method := trailer
+ 				createMethod: numberOfBytes
+ 				class: self
+ 				header:    (nArgs bitShift: 24)
+ 						+ (nTemps bitShift: 18)
+ 						+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
+ 						+ nLits
+ 						+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]).
+ 	primitiveIndex > 0 ifTrue:
+ 		[pc := method initialPC.
+ 		 method
+ 			at: pc + 0 put: method encoderClass callPrimitiveCode;
+ 			at: pc + 1 put: (primitiveIndex bitAnd: 16rFF);
+ 			at: pc + 2 put: (primitiveIndex bitShift: -8)].
+ 	^method!

Item was added:
+ ----- Method: CompiledCode 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."
+ 	| method pc |
+ 	nArgs > 15 ifTrue:
+ 		[^self error: 'Cannot compile -- too many arguments'].
+ 	nTemps > 63 ifTrue:
+ 		[^self error: 'Cannot compile -- too many temporary variables'].	
+ 	nLits > 32767 ifTrue:
+ 		[^self error: 'Cannot compile -- too many literals'].
+ 
+ 	method := trailer
+ 				createMethod: numberOfBytes
+ 				class: self
+ 				header:    (nArgs bitShift: 24)
+ 						+ (nTemps bitShift: 18)
+ 						+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
+ 						+ nLits
+ 						+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
+ 						+ (flag ifTrue: [1 bitShift: 29] ifFalse: [0]).
+ 	primitiveIndex > 0 ifTrue:
+ 		[pc := method initialPC.
+ 		 method
+ 			at: pc + 0 put: method encoderClass callPrimitiveCode;
+ 			at: pc + 1 put: (primitiveIndex bitAnd: 16rFF);
+ 			at: pc + 2 put: (primitiveIndex bitShift: -8)].
+ 	^method!

Item was added:
+ ----- Method: CompiledCode class>>newFrom: (in category 'instance creation') -----
+ newFrom: aCompiledMethod
+ 	"Clone the argument, aCompiledMethod"
+ 	| inst |
+ 	"CompiledMethod newFrom: CompiledMethod class >> #newFrom:"
+ 	inst := self newMethod: aCompiledMethod basicSize - aCompiledMethod initialPC + 1
+ 				header: aCompiledMethod header.
+ 	1 to: aCompiledMethod numLiterals do:
+ 		[:index|
+ 		inst literalAt: index put: (aCompiledMethod literalAt: index)].
+ 	aCompiledMethod initialPC to: aCompiledMethod size do:
+ 		[:index |
+ 		inst at: index put: (aCompiledMethod at: index)].
+ 	inst postCopy.
+ 	^inst!

Item was added:
+ ----- Method: CompiledCode class>>newInstanceFrom:variable:size:map: (in category 'instance creation') -----
+ newInstanceFrom: oldInstance variable: variable size: instSize map: map
+ 	"Create a new instance of the receiver based on the given old instance.
+ 	The supplied map contains a mapping of the old instVar names into
+ 	the receiver's instVars"
+ 	| new |
+ 	new := self newFrom: oldInstance.
+ 	1 to: instSize do: 
+ 		[:offset |  (map at: offset) > 0 ifTrue:
+ 			[new instVarAt: offset
+ 					put: (oldInstance instVarAt: (map at: offset))]].
+ 	^new!

Item was added:
+ ----- Method: CompiledCode class>>newMethod:header: (in category 'instance creation') -----
+ newMethod: numberOfBytes header: headerWord
+ 	"Primitive. Answer an instance of me. The number of literals (and other 
+ 	 information) is specified by the headerWord (see my class comment).
+ 	 The first argument specifies the number of fields for bytecodes in the
+ 	 method. Fail if either argument is not a SmallInteger, or if numberOfBytes
+ 	 is negative, or if memory is low. Once the header of a method is set by
+ 	 this primitive, it cannot be changed to change the number of literals.
+ 	 Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 79 error: ec>
+ 	ec == #'insufficient object memory' ifTrue:
+ 		[^self handleFailingNewMethod: numberOfBytes header: headerWord].
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: CompiledCode class>>newMethodViaNewError (in category 'private') -----
+ newMethodViaNewError
+ 
+ 	^self error: self class name, 's may only be created with newMethod:header:'!

Item was added:
+ ----- Method: CompiledCode class>>smallFrameSize (in category 'constants') -----
+ smallFrameSize
+ 
+ 	^ SmallFrame!

Item was added:
+ ----- Method: CompiledCode>>isCompiledBlock (in category 'testing') -----
+ isCompiledBlock
+ 	^false!

Item was added:
+ ----- Method: CompiledCode>>isCompiledCode (in category 'testing') -----
+ isCompiledCode
+ 	^true!

Item was added:
+ ----- Method: CompiledCode>>isCompiledMethod (in category 'testing') -----
+ isCompiledMethod
+ 	^false!

Item was removed:
- ----- Method: CompiledMethod class>>basicNew (in category 'instance creation') -----
- basicNew
- 
- 	self error: 'CompiledMethods may only be created with newMethod:header:' !

Item was removed:
- ----- Method: CompiledMethod class>>basicNew: (in category 'instance creation') -----
- basicNew: size
- 
- 	self error: 'CompiledMethods may only be created with newMethod:header:' !

Item was removed:
- ----- Method: CompiledMethod class>>fullFrameSize (in category 'constants') -----
- fullFrameSize  "CompiledMethod fullFrameSize"
- 	^ LargeFrame!

Item was removed:
- ----- Method: CompiledMethod class>>handleFailingFailingNewMethod:header: (in category 'private') -----
- handleFailingFailingNewMethod: numberOfBytes header: headerWord
- 	"This newMethod:header: gets sent after handleFailingBasicNew: has done a full
- 	 garbage collection and possibly grown memory.  If this basicNew: fails then the
- 	 system really is low on space, so raise the OutOfMemory signal.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable variables
- 	 specified by the argument, headerWord, and the number of bytecodes specified
- 	 by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
- 	 is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
- 	 memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 79>
- 	"space must be low."
- 	OutOfMemory signal.
- 	"retry if user proceeds"
- 	^self newMethod: numberOfBytes header: headerWord!

Item was removed:
- ----- Method: CompiledMethod class>>handleFailingNewMethod:header: (in category 'private') -----
- handleFailingNewMethod: numberOfBytes header: headerWord
- 	"This newMethod:header: gets sent after newMethod:header: has failed
- 	 and allowed a scavenging garbage collection to occur.  The scavenging
- 	 collection will have happened as the VM is activating the (failing) basicNew:.
- 	 If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
- 	 space and a global garbage collection is required.  Retry after garbage
- 	 collecting and growing memory if necessary.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable variables
- 	 specified by the argument, headerWord, and the number of bytecodes specified
- 	 by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
- 	 is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
- 	 memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 79>
- 	| bytesRequested |
- 	bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16.
- 	Smalltalk garbageCollect < bytesRequested ifTrue:
- 		[Smalltalk growMemoryByAtLeast: bytesRequested].
- 	"retry after global garbage collect and possible grow"
- 	^self handleFailingFailingNewMethod: numberOfBytes header: headerWord!

Item was removed:
- ----- Method: CompiledMethod class>>headerFlagForEncoder: (in category 'method encoding') -----
- headerFlagForEncoder: anEncoder
- 	anEncoder class == PrimaryBytecodeSetEncoderClass ifTrue:
- 		[^0].
- 	anEncoder class == SecondaryBytecodeSetEncoderClass ifTrue:
- 		[^SmallInteger minVal].
- 	self error: 'The encoder is not one of the two installed bytecode sets'!

Item was removed:
- ----- Method: CompiledMethod class>>initialize (in category 'class initialization') -----
- initialize    "CompiledMethod initialize"
- 	"Initialize class variables specifying the size of the temporary frame
- 	needed to run instances of me."
- 
- 	SmallFrame := 16.	"Context range for temps+stack"
- 	LargeFrame := 56.
- 	PrimaryBytecodeSetEncoderClass ifNil:
- 		[PrimaryBytecodeSetEncoderClass := EncoderForV3PlusClosures].
- 	SecondaryBytecodeSetEncoderClass ifNil:
- 		[SecondaryBytecodeSetEncoderClass := EncoderForV3PlusClosures]!

Item was removed:
- ----- Method: CompiledMethod class>>installPrimaryBytecodeSet: (in category 'class initialization') -----
- installPrimaryBytecodeSet: aBytecodeEncoderSubclass
- 	PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue:
- 		[^self].
- 	(aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse:
- 		[self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder'].
- 	(self allSubInstances
- 			detect: [:m| m header >= 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]]
- 			ifNone: []) ifNotNil:
- 		[Warning signal: 'There are existing CompiledMethods with a different encoderClass.'].
- 	PrimaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass!

Item was removed:
- ----- Method: CompiledMethod class>>installSecondaryBytecodeSet: (in category 'class initialization') -----
- installSecondaryBytecodeSet: aBytecodeEncoderSubclass
- 	PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue:
- 		[^self].
- 	(aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse:
- 		[self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder'].
- 	(self allSubInstances
- 			detect: [:m| m header < 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]]
- 			ifNone: []) ifNotNil:
- 		[Warning signal: 'There are existing CompiledMethods with a different encoderClass.'].
- 	SecondaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass!

Item was removed:
- ----- Method: CompiledMethod class>>maxNumLiterals (in category 'constants') -----
- maxNumLiterals
- 	"The current header format and the VM's interpretation of it allows for a maximum of 32767 literals."
- 	^32767!

Item was removed:
- ----- Method: CompiledMethod class>>new (in category 'instance creation') -----
- new
- 	"This will not make a meaningful method, but it could be used
- 	to invoke some otherwise useful method in this class."
- 	^self newMethod: 2 header: 1024!

Item was removed:
- ----- Method: CompiledMethod class>>new: (in category 'instance creation') -----
- new: size
- 
- 	self error: 'CompiledMethods may only be created with newMethod:header:'!

Item was removed:
- ----- 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."
- 	| method pc |
- 	nArgs > 15 ifTrue:
- 		[^self error: 'Cannot compile -- too many arguments'].
- 	nTemps > 63 ifTrue:
- 		[^self error: 'Cannot compile -- too many temporary variables'].	
- 	nLits > 32767 ifTrue:
- 		[^self error: 'Cannot compile -- too many literals'].
- 
- 	method := trailer
- 				createMethod: numberOfBytes
- 				class: self
- 				header:    (nArgs bitShift: 24)
- 						+ (nTemps bitShift: 18)
- 						+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
- 						+ nLits
- 						+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]).
- 	primitiveIndex > 0 ifTrue:
- 		[pc := method initialPC.
- 		 method
- 			at: pc + 0 put: method encoderClass callPrimitiveCode;
- 			at: pc + 1 put: (primitiveIndex bitAnd: 16rFF);
- 			at: pc + 2 put: (primitiveIndex bitShift: -8)].
- 	^method!

Item was removed:
- ----- 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."
- 	| method pc |
- 	nArgs > 15 ifTrue:
- 		[^self error: 'Cannot compile -- too many arguments'].
- 	nTemps > 63 ifTrue:
- 		[^self error: 'Cannot compile -- too many temporary variables'].	
- 	nLits > 32767 ifTrue:
- 		[^self error: 'Cannot compile -- too many literals'].
- 
- 	method := trailer
- 				createMethod: numberOfBytes
- 				class: self
- 				header:    (nArgs bitShift: 24)
- 						+ (nTemps bitShift: 18)
- 						+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
- 						+ nLits
- 						+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
- 						+ (flag ifTrue: [1 bitShift: 29] ifFalse: [0]).
- 	primitiveIndex > 0 ifTrue:
- 		[pc := method initialPC.
- 		 method
- 			at: pc + 0 put: method encoderClass callPrimitiveCode;
- 			at: pc + 1 put: (primitiveIndex bitAnd: 16rFF);
- 			at: pc + 2 put: (primitiveIndex bitShift: -8)].
- 	^method!

Item was removed:
- ----- Method: CompiledMethod class>>newFrom: (in category 'instance creation') -----
- newFrom: aCompiledMethod
- 	"Clone the argument, aCompiledMethod"
- 	| inst |
- 	"CompiledMethod newFrom: CompiledMethod class >> #newFrom:"
- 	inst := self newMethod: aCompiledMethod basicSize - aCompiledMethod initialPC + 1
- 				header: aCompiledMethod header.
- 	1 to: aCompiledMethod numLiterals do:
- 		[:index|
- 		inst literalAt: index put: (aCompiledMethod literalAt: index)].
- 	aCompiledMethod initialPC to: aCompiledMethod size do:
- 		[:index |
- 		inst at: index put: (aCompiledMethod at: index)].
- 	inst postCopy.
- 	^inst!

Item was removed:
- ----- Method: CompiledMethod class>>newInstanceFrom:variable:size:map: (in category 'instance creation') -----
- newInstanceFrom: oldInstance variable: variable size: instSize map: map
- 	"Create a new instance of the receiver based on the given old instance.
- 	The supplied map contains a mapping of the old instVar names into
- 	the receiver's instVars"
- 	| new |
- 	new := self newFrom: oldInstance.
- 	1 to: instSize do: 
- 		[:offset |  (map at: offset) > 0 ifTrue:
- 			[new instVarAt: offset
- 					put: (oldInstance instVarAt: (map at: offset))]].
- 	^new!

Item was removed:
- ----- Method: CompiledMethod class>>newMethod:header: (in category 'instance creation') -----
- newMethod: numberOfBytes header: headerWord
- 	"Primitive. Answer an instance of me. The number of literals (and other 
- 	 information) is specified by the headerWord (see my class comment).
- 	 The first argument specifies the number of fields for bytecodes in the
- 	 method. Fail if either argument is not a SmallInteger, or if numberOfBytes
- 	 is negative, or if memory is low. Once the header of a method is set by
- 	 this primitive, it cannot be changed to change the number of literals.
- 	 Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 79 error: ec>
- 	ec == #'insufficient object memory' ifTrue:
- 		[^self handleFailingNewMethod: numberOfBytes header: headerWord].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: CompiledMethod class>>smallFrameSize (in category 'constants') -----
- smallFrameSize
- 
- 	^ SmallFrame!

Item was added:
+ ----- Method: Object>>isCompiledCode (in category 'testing') -----
+ isCompiledCode
+ 	^false!



More information about the Packages mailing list