Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.876.mcz
==================== Summary ====================
Name: Kernel-eem.876
Author: eem
Time: 29 September 2014, 2:21:45.514 pm
UUID: 9ea5bea7-14c9-48c9-9d49-ca311d68d49a
Ancestors: Kernel-ul.875
Fix handleSignal: for a rare edge case that can
occur on Stack & Cog VMs.
=============== Diff against Kernel-ul.875 ===============
Item was changed:
----- Method: ContextPart>>handleSignal: (in category 'private-exceptions') -----
handleSignal: exception
+ "Sent to handler (on:do:) contexts only. If my exception class (first arg) handles exception
+ and the handler is active then execute my handle block (second arg), otherwise forward
+ this message to the next handler context. If none left, execute exception's defaultAction
+ (see nil>>handleSignal:)."
- "Sent to handler (on:do:) contexts only. If my exception class (first arg) handles exception then execute my handle block (second arg), otherwise forward this message to the next handler context. If none left, execute exception's defaultAction (see nil>>handleSignal:)."
+ | handlerActive val |
+ "If the context has been returned from the handlerActive temp var may not be accessible."
+ handlerActive := stackp >= 3 and: [(self tempAt: 3) == true].
+ (((self tempAt: 1) handles: exception) and: [handlerActive]) ifFalse:
+ [^self nextHandlerContext handleSignal: exception].
- | val |
- (((self tempAt: 1) handles: exception) and: [self tempAt: 3]) ifFalse: [
- ^ self nextHandlerContext handleSignal: exception].
exception privHandlerContext: self contextTag.
self tempAt: 3 put: false. "disable self while executing handle block"
+ val := [(self tempAt: 2) cull: exception]
+ ensure: [self tempAt: 3 put: true].
+ self return: val "return from self if not otherwise directed in handle block"
- val := [(self tempAt: 2) cull: exception ]
- ensure: [self tempAt: 3 put: true].
- self return: val. "return from self if not otherwise directed in handle block"
!
1
0
Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.876.mcz
==================== Summary ====================
Name: Kernel-eem.876
Author: eem
Time: 29 September 2014, 2:21:45.514 pm
UUID: 9ea5bea7-14c9-48c9-9d49-ca311d68d49a
Ancestors: Kernel-ul.875
Fix handleSignal: for a rare edge case that can
occur on Stack & Cog VMs.
=============== Diff against Kernel-ul.875 ===============
Item was changed:
----- Method: ContextPart>>handleSignal: (in category 'private-exceptions') -----
handleSignal: exception
+ "Sent to handler (on:do:) contexts only. If my exception class (first arg) handles exception
+ and the handler is active then execute my handle block (second arg), otherwise forward
+ this message to the next handler context. If none left, execute exception's defaultAction
+ (see nil>>handleSignal:)."
- "Sent to handler (on:do:) contexts only. If my exception class (first arg) handles exception then execute my handle block (second arg), otherwise forward this message to the next handler context. If none left, execute exception's defaultAction (see nil>>handleSignal:)."
+ | handlerActive val |
+ "If the context has been returned from the handlerActive temp var may not be accessible."
+ handlerActive := stackp >= 3 and: [(self tempAt: 3) == true].
+ (((self tempAt: 1) handles: exception) and: [handlerActive]) ifFalse:
+ [^self nextHandlerContext handleSignal: exception].
- | val |
- (((self tempAt: 1) handles: exception) and: [self tempAt: 3]) ifFalse: [
- ^ self nextHandlerContext handleSignal: exception].
exception privHandlerContext: self contextTag.
self tempAt: 3 put: false. "disable self while executing handle block"
+ val := [(self tempAt: 2) cull: exception]
+ ensure: [self tempAt: 3 put: true].
+ self return: val "return from self if not otherwise directed in handle block"
- val := [(self tempAt: 2) cull: exception ]
- ensure: [self tempAt: 3 put: true].
- self return: val. "return from self if not otherwise directed in handle block"
!
1
0
Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.876.mcz
==================== Summary ====================
Name: Kernel-eem.876
Author: eem
Time: 29 September 2014, 2:21:45.514 pm
UUID: 9ea5bea7-14c9-48c9-9d49-ca311d68d49a
Ancestors: Kernel-ul.875
Fix handleSignal: for a rare edge case that can
occur on Stack & Cog VMs.
=============== Diff against Kernel-ul.875 ===============
Item was changed:
----- Method: ContextPart>>handleSignal: (in category 'private-exceptions') -----
handleSignal: exception
+ "Sent to handler (on:do:) contexts only. If my exception class (first arg) handles exception
+ and the handler is active then execute my handle block (second arg), otherwise forward
+ this message to the next handler context. If none left, execute exception's defaultAction
+ (see nil>>handleSignal:)."
- "Sent to handler (on:do:) contexts only. If my exception class (first arg) handles exception then execute my handle block (second arg), otherwise forward this message to the next handler context. If none left, execute exception's defaultAction (see nil>>handleSignal:)."
+ | handlerActive val |
+ "If the context has been returned from the handlerActive temp var may not be accessible."
+ handlerActive := stackp >= 3 and: [(self tempAt: 3) == true].
+ (((self tempAt: 1) handles: exception) and: [handlerActive]) ifFalse:
+ [^self nextHandlerContext handleSignal: exception].
- | val |
- (((self tempAt: 1) handles: exception) and: [self tempAt: 3]) ifFalse: [
- ^ self nextHandlerContext handleSignal: exception].
exception privHandlerContext: self contextTag.
self tempAt: 3 put: false. "disable self while executing handle block"
+ val := [(self tempAt: 2) cull: exception]
+ ensure: [self tempAt: 3 put: true].
+ self return: val "return from self if not otherwise directed in handle block"
- val := [(self tempAt: 2) cull: exception ]
- ensure: [self tempAt: 3 put: true].
- self return: val. "return from self if not otherwise directed in handle block"
!
1
0
Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System.spur-dtl.685.mcz
==================== Summary ====================
Name: System.spur-dtl.685
Author: eem
Time: 27 September 2014, 1:17:02.073 pm
UUID: b1dd4f4e-0266-4130-9183-4349427d2843
Ancestors: System-dtl.685
System-dtl.685 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.208
Smalltalk isRunningCog should answer false for an interpreter VM
=============== Diff against System-dtl.685 ===============
Item was changed:
----- Method: SmalltalkImage>>compactClassesArray (in category 'special objects') -----
compactClassesArray
"Smalltalk compactClassesArray"
+ "Backward-compatibility support. Spur does not have compact classes."
+ ^{}!
- "Return the array of 31 classes whose instances may be
- represented compactly"
- ^ self specialObjectsArray at: 29!
Item was added:
+ ----- Method: SmalltalkImage>>growMemoryByAtLeast: (in category 'memory space') -----
+ growMemoryByAtLeast: numBytes
+ "Grow memory by at least the requested number of bytes.
+ Primitive. Essential. Fail if no memory is available."
+ <primitive: 180>
+ (numBytes isInteger and: [numBytes > 0]) ifTrue:
+ [OutOfMemory signal].
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SmalltalkImage>>maxIdentityHash (in category 'system attributes') -----
+ maxIdentityHash
+ "Answer the maximum identityHash value supported by the VM."
+ <primitive: 176>
+ ^self primitiveFailed!
Item was changed:
----- Method: SmalltalkImage>>recreateSpecialObjectsArray (in category 'special objects') -----
recreateSpecialObjectsArray
"Smalltalk recreateSpecialObjectsArray"
"To external package developers:
**** DO NOT OVERRIDE THIS METHOD. *****
If you are writing a plugin and need additional special object(s) for your own use,
use addGCRoot() function and use own, separate special objects registry "
"The Special Objects Array is an array of objects used by the Squeak virtual machine.
Its contents are critical and accesses to it by the VM are unchecked, so don't even
think of playing here unless you know what you are doing."
| newArray |
+ newArray := Array new: 60.
- newArray := Array new: 58.
"Nil false and true get used throughout the interpreter"
newArray at: 1 put: nil.
newArray at: 2 put: false.
newArray at: 3 put: true.
"This association holds the active process (a ProcessScheduler)"
newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
"Numerous classes below used for type checking and instantiation"
newArray at: 5 put: Bitmap.
newArray at: 6 put: SmallInteger.
newArray at: 7 put: ByteString.
newArray at: 8 put: Array.
newArray at: 9 put: Smalltalk.
newArray at: 10 put: Float.
+ newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
+ newArray at: 12 put: nil. "was BlockContext."
- newArray at: 11 put: MethodContext.
- newArray at: 12 put: BlockContext.
newArray at: 13 put: Point.
newArray at: 14 put: LargePositiveInteger.
newArray at: 15 put: Display.
newArray at: 16 put: Message.
newArray at: 17 put: CompiledMethod.
+ newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
- newArray at: 18 put: (self specialObjectsArray at: 18).
- "(low space Semaphore)"
newArray at: 19 put: Semaphore.
newArray at: 20 put: Character.
newArray at: 21 put: #doesNotUnderstand:.
newArray at: 22 put: #cannotReturn:.
newArray at: 23 put: nil. "This is the process signalling low space."
"An array of the 32 selectors that are compiled as special bytecodes,
paired alternately with the number of arguments each takes."
newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
#* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
#at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
#blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
"An array of the 255 Characters in ascii order.
+ Cog inlines table into machine code at: prim so do not regenerate it.
+ This is nil in Spur, which has immediate Characters."
- Cog inlines table into machine code at: prim so do not regenerate it."
newArray at: 25 put: (self specialObjectsArray at: 25).
newArray at: 26 put: #mustBeBoolean.
newArray at: 27 put: ByteArray.
newArray at: 28 put: Process.
+ "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
- "An array of up to 31 classes whose instances will have compact headers"
newArray at: 29 put: self compactClassesArray.
+ newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
+ newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
- newArray at: 30 put: (self specialObjectsArray at: 30). "(delay Semaphore)"
- newArray at: 31 put: (self specialObjectsArray at: 31). "(user interrupt Semaphore)"
"Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
+ newArray at: 32 put: nil. "was the prototype Float"
+ newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
+ newArray at: 34 put: nil. "was the prototype Point"
- newArray at: 32 put: nil. "was (Float new: 2)"
- newArray at: 33 put: nil. "was (LargePositiveInteger new: 4)"
- newArray at: 34 put: nil. "was Point new"
newArray at: 35 put: #cannotInterpret:.
+ newArray at: 36 put: nil. "was the prototype MethodContext"
- "Note: This must be fixed once we start using context prototypes (yeah, right)"
- "(MethodContext new: CompiledMethod fullFrameSize)."
- newArray at: 36 put: (self specialObjectsArray at: 36). "Is the prototype MethodContext (unused by the VM)"
newArray at: 37 put: BlockClosure.
+ newArray at: 38 put: nil. "was the prototype BlockContext"
- "(BlockContext new: CompiledMethod fullFrameSize)."
- newArray at: 38 put: (self specialObjectsArray at: 38). "Is the prototype BlockContext (unused by the VM)"
"array of objects referred to by external code"
+ newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
- newArray at: 39 put: (self specialObjectsArray at: 39). "preserve external semaphores"
newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
+ newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
+ newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
- newArray at: 41 put: nil. "Reserved for a LinkedList instance for overlapped calls in CogMT"
- "finalization Semaphore"
- newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]).
newArray at: 43 put: LargeNegativeInteger.
"External objects for callout.
Note: Written so that one can actually completely remove the FFI."
newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
newArray at: 49 put: #aboutToReturn:through:.
newArray at: 50 put: #run:with:in:.
"51 reserved for immutability message"
+ newArray at: 51 put: #attemptToAssign:withIndex:.
- "newArray at: 51 put: #attemptToAssign:withIndex:."
- newArray at: 51 put: (self specialObjectsArray at: 51 ifAbsent: []).
newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
#'bad argument' #'bad index'
#'bad number of arguments'
#'inappropriate operation' #'unsupported operation'
#'no modification' #'insufficient object memory'
#'insufficient C memory' #'not found' #'bad method'
#'internal error in named primitive machinery'
#'object may move' #'resource limit exceeded'
+ #'object is pinned' #'primitive write beyond end of object').
- #'object is pinned').
"53 to 55 are for Alien"
newArray at: 53 put: (self at: #Alien ifAbsent: []).
+ newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
- newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
+ "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
+ newArray at: 56 put: nil.
- "Weak reference finalization"
- newArray at: 56 put: (self at: #WeakFinalizationList ifAbsent: []).
"reserved for foreign callback process"
newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
newArray at: 58 put: #unusedBytecode.
+ "59 reserved for Sista counter tripped message"
+ newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
+ "60 reserved for Sista class trap message"
+ newArray at: 60 put: #classTrapFor:.
"Now replace the interpreter's reference in one atomic operation"
+ self specialObjectsArray becomeForward: newArray!
- self specialObjectsArray becomeForward: newArray
- !
Item was changed:
----- Method: SmalltalkImage>>setGCParameters (in category 'snapshot and quit') -----
setGCParameters
+ "Adjust the VM's default GC parameters to avoid too much tenuring.
+ Maybe this should be left to the VM?"
- "Adjust the VM's default GC parameters to avoid premature tenuring."
+ | proportion edenSize survivorSize averageObjectSize numObjects |
+ proportion := 0.9. "tenure when 90% of pastSpace is full"
+ edenSize := SmalltalkImage current vmParameterAt: 44.
+ survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ averageObjectSize := 8 * self wordSize. "a good approximation"
+ numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
- self vmParameterAt: 5 put: 4000. "do an incremental GC after this many allocations"
- self vmParameterAt: 6 put: 2000. "tenure when more than this many objects survive the GC"
- !
Item was changed:
----- Method: SpaceTally>>spaceForInstancesOf: (in category 'instance size') -----
spaceForInstancesOf: aClass
+ "Answer a pair of the number of bytes consumed by all instances of the
+ given class, including their object headers, and the number of instances."
- "Answer the number of bytes consumed by all instances of the given class, including their object headers and the number of instances."
+ | instances total |
+ instances := aClass allInstances.
+ instances isEmpty ifTrue: [^#(0 0)].
- | smallHeaderSize instVarBytes isVariable bytesPerElement total lastInstance instance instanceCount |
- instance := aClass someInstance ifNil: [ ^#(0 0) ].
- smallHeaderSize := aClass isCompact ifTrue: [ 4 ] ifFalse: [ 8 ].
- instVarBytes := aClass instSize * 4.
- isVariable := aClass isVariable.
- bytesPerElement := isVariable
- ifFalse: [ 0 ]
- ifTrue: [ aClass isBytes ifTrue: [ 1 ] ifFalse: [ 4 ] ].
total := 0.
+ aClass isVariable
+ ifTrue:
+ [instances do:
+ [:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]]
+ ifFalse:
+ [total := instances size * aClass byteSizeOfInstance].
+ ^{ total. instances size }!
- instanceCount := 0.
- "A modified version of #allInstancesDo: is inlined here. It avoids an infinite loop when another process is creating new instances of aClass."
- self flag: #allInstancesDo:.
- lastInstance :=
- aClass == CompiledMethod "CompiledMethod has special format, see its class comment"
- ifTrue: [aClass new]
- ifFalse: [aClass basicNew].
- [ instance == lastInstance ] whileFalse: [
- | contentBytes headerBytes |
- contentBytes := instVarBytes + (isVariable
- ifFalse: [ 0 ]
- ifTrue: [ instance basicSize * bytesPerElement ]).
- headerBytes := contentBytes > 255
- ifTrue: [ 12 ]
- ifFalse: [ smallHeaderSize ].
- total := total + headerBytes + (contentBytes roundUpTo: 4).
- instanceCount := instanceCount + 1.
- instance := instance nextInstance ].
- ^{ total. instanceCount }!
Item was added:
+ ----- Method: SystemDictionary>>growMemoryByAtLeast: (in category 'memory space') -----
+ growMemoryByAtLeast: numBytes
+ "Grow memory by at least the requested number of bytes.
+ Primitive. Fail if no memory is available. Essential."
+ <primitive: 180>
+ ^(numBytes isInteger and: [numBytes > 0])
+ ifTrue: [OutOfMemory signal]
+ ifFalse: [self primitiveFailed]!
Item was added:
+ ----- Method: SystemDictionary>>maxIdentityHash (in category 'system attributes') -----
+ maxIdentityHash
+ "Answer the maximum identityHash value supported by the VM."
+ <primitive: 176>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SystemDictionary>>setGCParameters (in category 'snapshot and quit') -----
+ setGCParameters
+ "Adjust the VM's default GC parameters to avoid too much tenuring.
+ Maybe this should be left to the VM?"
+
+ | proportion edenSize survivorSize averageObjectSize numObjects |
+ proportion := 0.9. "tenure when 90% of pastSpace is full"
+ edenSize := SmalltalkImage current vmParameterAt: 44.
+ survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ averageObjectSize := 8 * self wordSize. "a good approximation"
+ numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
Item was added:
+ ----- Method: SystemNavigation>>allObjects (in category 'query') -----
+ allObjects
+ "Answer an Array of all objects in the system. Fail if
+ there isn't enough memory to instantiate the result."
+ <primitive: 178>
+ ^self primitiveFailed!
Item was changed:
----- Method: SystemNavigation>>allObjectsDo: (in category 'query') -----
allObjectsDo: aBlock
+ "Evaluate the argument, aBlock, for each object in the system, excluding immediates
+ such as SmallInteger and Character."
+ self allObjectsOrNil
+ ifNotNil: [:allObjects| allObjects do: aBlock]
+ ifNil:
+ ["Fall back on the old single object primitive code. With closures, this needs
+ to use an end marker (lastObject) since activation of the block will create
+ new contexts and cause an infinite loop. The lastObject must be created
+ before calling someObject, so that the VM can settle the enumeration (e.g.
+ by flushing new space) as a side effect of someObject"
+ | object lastObject |
+ lastObject := Object new.
+ object := self someObject.
+ [lastObject == object or: [0 == object]] whileFalse:
+ [aBlock value: object.
+ object := object nextObject]]!
- "Evaluate the argument, aBlock, for each object in the system
- excluding SmallIntegers. With closures, this needs to use an end
- marker (lastObject) since activation of the block will create new
- contexts and cause an infinite loop."
- | object lastObject |
- object := self someObject.
- lastObject := Object new.
- [lastObject == object or: [0 == object]]
- whileFalse: [aBlock value: object.
- object := object nextObject]!
Item was added:
+ ----- Method: SystemNavigation>>allObjectsOrNil (in category 'query') -----
+ allObjectsOrNil
+ "Answer an Array of all objects in the system. Fail if there isn't
+ enough memory to instantiate the result and answer nil."
+ <primitive: 178>
+ ^nil!
1
0
Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System.spur-dtl.685.mcz
==================== Summary ====================
Name: System.spur-dtl.685
Author: eem
Time: 27 September 2014, 1:17:02.073 pm
UUID: b1dd4f4e-0266-4130-9183-4349427d2843
Ancestors: System-dtl.685
System-dtl.685 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.208
Smalltalk isRunningCog should answer false for an interpreter VM
=============== Diff against System-dtl.685 ===============
Item was changed:
----- Method: SmalltalkImage>>compactClassesArray (in category 'special objects') -----
compactClassesArray
"Smalltalk compactClassesArray"
+ "Backward-compatibility support. Spur does not have compact classes."
+ ^{}!
- "Return the array of 31 classes whose instances may be
- represented compactly"
- ^ self specialObjectsArray at: 29!
Item was added:
+ ----- Method: SmalltalkImage>>growMemoryByAtLeast: (in category 'memory space') -----
+ growMemoryByAtLeast: numBytes
+ "Grow memory by at least the requested number of bytes.
+ Primitive. Essential. Fail if no memory is available."
+ <primitive: 180>
+ (numBytes isInteger and: [numBytes > 0]) ifTrue:
+ [OutOfMemory signal].
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SmalltalkImage>>maxIdentityHash (in category 'system attributes') -----
+ maxIdentityHash
+ "Answer the maximum identityHash value supported by the VM."
+ <primitive: 176>
+ ^self primitiveFailed!
Item was changed:
----- Method: SmalltalkImage>>recreateSpecialObjectsArray (in category 'special objects') -----
recreateSpecialObjectsArray
"Smalltalk recreateSpecialObjectsArray"
"To external package developers:
**** DO NOT OVERRIDE THIS METHOD. *****
If you are writing a plugin and need additional special object(s) for your own use,
use addGCRoot() function and use own, separate special objects registry "
"The Special Objects Array is an array of objects used by the Squeak virtual machine.
Its contents are critical and accesses to it by the VM are unchecked, so don't even
think of playing here unless you know what you are doing."
| newArray |
+ newArray := Array new: 60.
- newArray := Array new: 58.
"Nil false and true get used throughout the interpreter"
newArray at: 1 put: nil.
newArray at: 2 put: false.
newArray at: 3 put: true.
"This association holds the active process (a ProcessScheduler)"
newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
"Numerous classes below used for type checking and instantiation"
newArray at: 5 put: Bitmap.
newArray at: 6 put: SmallInteger.
newArray at: 7 put: ByteString.
newArray at: 8 put: Array.
newArray at: 9 put: Smalltalk.
newArray at: 10 put: Float.
+ newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
+ newArray at: 12 put: nil. "was BlockContext."
- newArray at: 11 put: MethodContext.
- newArray at: 12 put: BlockContext.
newArray at: 13 put: Point.
newArray at: 14 put: LargePositiveInteger.
newArray at: 15 put: Display.
newArray at: 16 put: Message.
newArray at: 17 put: CompiledMethod.
+ newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
- newArray at: 18 put: (self specialObjectsArray at: 18).
- "(low space Semaphore)"
newArray at: 19 put: Semaphore.
newArray at: 20 put: Character.
newArray at: 21 put: #doesNotUnderstand:.
newArray at: 22 put: #cannotReturn:.
newArray at: 23 put: nil. "This is the process signalling low space."
"An array of the 32 selectors that are compiled as special bytecodes,
paired alternately with the number of arguments each takes."
newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
#* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
#at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
#blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
"An array of the 255 Characters in ascii order.
+ Cog inlines table into machine code at: prim so do not regenerate it.
+ This is nil in Spur, which has immediate Characters."
- Cog inlines table into machine code at: prim so do not regenerate it."
newArray at: 25 put: (self specialObjectsArray at: 25).
newArray at: 26 put: #mustBeBoolean.
newArray at: 27 put: ByteArray.
newArray at: 28 put: Process.
+ "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
- "An array of up to 31 classes whose instances will have compact headers"
newArray at: 29 put: self compactClassesArray.
+ newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
+ newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
- newArray at: 30 put: (self specialObjectsArray at: 30). "(delay Semaphore)"
- newArray at: 31 put: (self specialObjectsArray at: 31). "(user interrupt Semaphore)"
"Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
+ newArray at: 32 put: nil. "was the prototype Float"
+ newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
+ newArray at: 34 put: nil. "was the prototype Point"
- newArray at: 32 put: nil. "was (Float new: 2)"
- newArray at: 33 put: nil. "was (LargePositiveInteger new: 4)"
- newArray at: 34 put: nil. "was Point new"
newArray at: 35 put: #cannotInterpret:.
+ newArray at: 36 put: nil. "was the prototype MethodContext"
- "Note: This must be fixed once we start using context prototypes (yeah, right)"
- "(MethodContext new: CompiledMethod fullFrameSize)."
- newArray at: 36 put: (self specialObjectsArray at: 36). "Is the prototype MethodContext (unused by the VM)"
newArray at: 37 put: BlockClosure.
+ newArray at: 38 put: nil. "was the prototype BlockContext"
- "(BlockContext new: CompiledMethod fullFrameSize)."
- newArray at: 38 put: (self specialObjectsArray at: 38). "Is the prototype BlockContext (unused by the VM)"
"array of objects referred to by external code"
+ newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
- newArray at: 39 put: (self specialObjectsArray at: 39). "preserve external semaphores"
newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
+ newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
+ newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
- newArray at: 41 put: nil. "Reserved for a LinkedList instance for overlapped calls in CogMT"
- "finalization Semaphore"
- newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]).
newArray at: 43 put: LargeNegativeInteger.
"External objects for callout.
Note: Written so that one can actually completely remove the FFI."
newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
newArray at: 49 put: #aboutToReturn:through:.
newArray at: 50 put: #run:with:in:.
"51 reserved for immutability message"
+ newArray at: 51 put: #attemptToAssign:withIndex:.
- "newArray at: 51 put: #attemptToAssign:withIndex:."
- newArray at: 51 put: (self specialObjectsArray at: 51 ifAbsent: []).
newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
#'bad argument' #'bad index'
#'bad number of arguments'
#'inappropriate operation' #'unsupported operation'
#'no modification' #'insufficient object memory'
#'insufficient C memory' #'not found' #'bad method'
#'internal error in named primitive machinery'
#'object may move' #'resource limit exceeded'
+ #'object is pinned' #'primitive write beyond end of object').
- #'object is pinned').
"53 to 55 are for Alien"
newArray at: 53 put: (self at: #Alien ifAbsent: []).
+ newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
- newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
+ "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
+ newArray at: 56 put: nil.
- "Weak reference finalization"
- newArray at: 56 put: (self at: #WeakFinalizationList ifAbsent: []).
"reserved for foreign callback process"
newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
newArray at: 58 put: #unusedBytecode.
+ "59 reserved for Sista counter tripped message"
+ newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
+ "60 reserved for Sista class trap message"
+ newArray at: 60 put: #classTrapFor:.
"Now replace the interpreter's reference in one atomic operation"
+ self specialObjectsArray becomeForward: newArray!
- self specialObjectsArray becomeForward: newArray
- !
Item was changed:
----- Method: SmalltalkImage>>setGCParameters (in category 'snapshot and quit') -----
setGCParameters
+ "Adjust the VM's default GC parameters to avoid too much tenuring.
+ Maybe this should be left to the VM?"
- "Adjust the VM's default GC parameters to avoid premature tenuring."
+ | proportion edenSize survivorSize averageObjectSize numObjects |
+ proportion := 0.9. "tenure when 90% of pastSpace is full"
+ edenSize := SmalltalkImage current vmParameterAt: 44.
+ survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ averageObjectSize := 8 * self wordSize. "a good approximation"
+ numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
- self vmParameterAt: 5 put: 4000. "do an incremental GC after this many allocations"
- self vmParameterAt: 6 put: 2000. "tenure when more than this many objects survive the GC"
- !
Item was changed:
----- Method: SpaceTally>>spaceForInstancesOf: (in category 'instance size') -----
spaceForInstancesOf: aClass
+ "Answer a pair of the number of bytes consumed by all instances of the
+ given class, including their object headers, and the number of instances."
- "Answer the number of bytes consumed by all instances of the given class, including their object headers and the number of instances."
+ | instances total |
+ instances := aClass allInstances.
+ instances isEmpty ifTrue: [^#(0 0)].
- | smallHeaderSize instVarBytes isVariable bytesPerElement total lastInstance instance instanceCount |
- instance := aClass someInstance ifNil: [ ^#(0 0) ].
- smallHeaderSize := aClass isCompact ifTrue: [ 4 ] ifFalse: [ 8 ].
- instVarBytes := aClass instSize * 4.
- isVariable := aClass isVariable.
- bytesPerElement := isVariable
- ifFalse: [ 0 ]
- ifTrue: [ aClass isBytes ifTrue: [ 1 ] ifFalse: [ 4 ] ].
total := 0.
+ aClass isVariable
+ ifTrue:
+ [instances do:
+ [:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]]
+ ifFalse:
+ [total := instances size * aClass byteSizeOfInstance].
+ ^{ total. instances size }!
- instanceCount := 0.
- "A modified version of #allInstancesDo: is inlined here. It avoids an infinite loop when another process is creating new instances of aClass."
- self flag: #allInstancesDo:.
- lastInstance :=
- aClass == CompiledMethod "CompiledMethod has special format, see its class comment"
- ifTrue: [aClass new]
- ifFalse: [aClass basicNew].
- [ instance == lastInstance ] whileFalse: [
- | contentBytes headerBytes |
- contentBytes := instVarBytes + (isVariable
- ifFalse: [ 0 ]
- ifTrue: [ instance basicSize * bytesPerElement ]).
- headerBytes := contentBytes > 255
- ifTrue: [ 12 ]
- ifFalse: [ smallHeaderSize ].
- total := total + headerBytes + (contentBytes roundUpTo: 4).
- instanceCount := instanceCount + 1.
- instance := instance nextInstance ].
- ^{ total. instanceCount }!
Item was added:
+ ----- Method: SystemDictionary>>growMemoryByAtLeast: (in category 'memory space') -----
+ growMemoryByAtLeast: numBytes
+ "Grow memory by at least the requested number of bytes.
+ Primitive. Fail if no memory is available. Essential."
+ <primitive: 180>
+ ^(numBytes isInteger and: [numBytes > 0])
+ ifTrue: [OutOfMemory signal]
+ ifFalse: [self primitiveFailed]!
Item was added:
+ ----- Method: SystemDictionary>>maxIdentityHash (in category 'system attributes') -----
+ maxIdentityHash
+ "Answer the maximum identityHash value supported by the VM."
+ <primitive: 176>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SystemDictionary>>setGCParameters (in category 'snapshot and quit') -----
+ setGCParameters
+ "Adjust the VM's default GC parameters to avoid too much tenuring.
+ Maybe this should be left to the VM?"
+
+ | proportion edenSize survivorSize averageObjectSize numObjects |
+ proportion := 0.9. "tenure when 90% of pastSpace is full"
+ edenSize := SmalltalkImage current vmParameterAt: 44.
+ survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ averageObjectSize := 8 * self wordSize. "a good approximation"
+ numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
Item was added:
+ ----- Method: SystemNavigation>>allObjects (in category 'query') -----
+ allObjects
+ "Answer an Array of all objects in the system. Fail if
+ there isn't enough memory to instantiate the result."
+ <primitive: 178>
+ ^self primitiveFailed!
Item was changed:
----- Method: SystemNavigation>>allObjectsDo: (in category 'query') -----
allObjectsDo: aBlock
+ "Evaluate the argument, aBlock, for each object in the system, excluding immediates
+ such as SmallInteger and Character."
+ self allObjectsOrNil
+ ifNotNil: [:allObjects| allObjects do: aBlock]
+ ifNil:
+ ["Fall back on the old single object primitive code. With closures, this needs
+ to use an end marker (lastObject) since activation of the block will create
+ new contexts and cause an infinite loop. The lastObject must be created
+ before calling someObject, so that the VM can settle the enumeration (e.g.
+ by flushing new space) as a side effect of someObject"
+ | object lastObject |
+ lastObject := Object new.
+ object := self someObject.
+ [lastObject == object or: [0 == object]] whileFalse:
+ [aBlock value: object.
+ object := object nextObject]]!
- "Evaluate the argument, aBlock, for each object in the system
- excluding SmallIntegers. With closures, this needs to use an end
- marker (lastObject) since activation of the block will create new
- contexts and cause an infinite loop."
- | object lastObject |
- object := self someObject.
- lastObject := Object new.
- [lastObject == object or: [0 == object]]
- whileFalse: [aBlock value: object.
- object := object nextObject]!
Item was added:
+ ----- Method: SystemNavigation>>allObjectsOrNil (in category 'query') -----
+ allObjectsOrNil
+ "Answer an Array of all objects in the system. Fail if there isn't
+ enough memory to instantiate the result and answer nil."
+ <primitive: 178>
+ ^nil!
1
0
Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System.spur-dtl.685.mcz
==================== Summary ====================
Name: System.spur-dtl.685
Author: eem
Time: 27 September 2014, 1:17:02.073 pm
UUID: b1dd4f4e-0266-4130-9183-4349427d2843
Ancestors: System-dtl.685
System-dtl.685 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.208
Smalltalk isRunningCog should answer false for an interpreter VM
=============== Diff against System-dtl.685 ===============
Item was changed:
----- Method: SmalltalkImage>>compactClassesArray (in category 'special objects') -----
compactClassesArray
"Smalltalk compactClassesArray"
+ "Backward-compatibility support. Spur does not have compact classes."
+ ^{}!
- "Return the array of 31 classes whose instances may be
- represented compactly"
- ^ self specialObjectsArray at: 29!
Item was added:
+ ----- Method: SmalltalkImage>>growMemoryByAtLeast: (in category 'memory space') -----
+ growMemoryByAtLeast: numBytes
+ "Grow memory by at least the requested number of bytes.
+ Primitive. Essential. Fail if no memory is available."
+ <primitive: 180>
+ (numBytes isInteger and: [numBytes > 0]) ifTrue:
+ [OutOfMemory signal].
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SmalltalkImage>>maxIdentityHash (in category 'system attributes') -----
+ maxIdentityHash
+ "Answer the maximum identityHash value supported by the VM."
+ <primitive: 176>
+ ^self primitiveFailed!
Item was changed:
----- Method: SmalltalkImage>>recreateSpecialObjectsArray (in category 'special objects') -----
recreateSpecialObjectsArray
"Smalltalk recreateSpecialObjectsArray"
"To external package developers:
**** DO NOT OVERRIDE THIS METHOD. *****
If you are writing a plugin and need additional special object(s) for your own use,
use addGCRoot() function and use own, separate special objects registry "
"The Special Objects Array is an array of objects used by the Squeak virtual machine.
Its contents are critical and accesses to it by the VM are unchecked, so don't even
think of playing here unless you know what you are doing."
| newArray |
+ newArray := Array new: 60.
- newArray := Array new: 58.
"Nil false and true get used throughout the interpreter"
newArray at: 1 put: nil.
newArray at: 2 put: false.
newArray at: 3 put: true.
"This association holds the active process (a ProcessScheduler)"
newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
"Numerous classes below used for type checking and instantiation"
newArray at: 5 put: Bitmap.
newArray at: 6 put: SmallInteger.
newArray at: 7 put: ByteString.
newArray at: 8 put: Array.
newArray at: 9 put: Smalltalk.
newArray at: 10 put: Float.
+ newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
+ newArray at: 12 put: nil. "was BlockContext."
- newArray at: 11 put: MethodContext.
- newArray at: 12 put: BlockContext.
newArray at: 13 put: Point.
newArray at: 14 put: LargePositiveInteger.
newArray at: 15 put: Display.
newArray at: 16 put: Message.
newArray at: 17 put: CompiledMethod.
+ newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
- newArray at: 18 put: (self specialObjectsArray at: 18).
- "(low space Semaphore)"
newArray at: 19 put: Semaphore.
newArray at: 20 put: Character.
newArray at: 21 put: #doesNotUnderstand:.
newArray at: 22 put: #cannotReturn:.
newArray at: 23 put: nil. "This is the process signalling low space."
"An array of the 32 selectors that are compiled as special bytecodes,
paired alternately with the number of arguments each takes."
newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
#* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
#at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
#blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
"An array of the 255 Characters in ascii order.
+ Cog inlines table into machine code at: prim so do not regenerate it.
+ This is nil in Spur, which has immediate Characters."
- Cog inlines table into machine code at: prim so do not regenerate it."
newArray at: 25 put: (self specialObjectsArray at: 25).
newArray at: 26 put: #mustBeBoolean.
newArray at: 27 put: ByteArray.
newArray at: 28 put: Process.
+ "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
- "An array of up to 31 classes whose instances will have compact headers"
newArray at: 29 put: self compactClassesArray.
+ newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
+ newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
- newArray at: 30 put: (self specialObjectsArray at: 30). "(delay Semaphore)"
- newArray at: 31 put: (self specialObjectsArray at: 31). "(user interrupt Semaphore)"
"Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
+ newArray at: 32 put: nil. "was the prototype Float"
+ newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
+ newArray at: 34 put: nil. "was the prototype Point"
- newArray at: 32 put: nil. "was (Float new: 2)"
- newArray at: 33 put: nil. "was (LargePositiveInteger new: 4)"
- newArray at: 34 put: nil. "was Point new"
newArray at: 35 put: #cannotInterpret:.
+ newArray at: 36 put: nil. "was the prototype MethodContext"
- "Note: This must be fixed once we start using context prototypes (yeah, right)"
- "(MethodContext new: CompiledMethod fullFrameSize)."
- newArray at: 36 put: (self specialObjectsArray at: 36). "Is the prototype MethodContext (unused by the VM)"
newArray at: 37 put: BlockClosure.
+ newArray at: 38 put: nil. "was the prototype BlockContext"
- "(BlockContext new: CompiledMethod fullFrameSize)."
- newArray at: 38 put: (self specialObjectsArray at: 38). "Is the prototype BlockContext (unused by the VM)"
"array of objects referred to by external code"
+ newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
- newArray at: 39 put: (self specialObjectsArray at: 39). "preserve external semaphores"
newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
+ newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
+ newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
- newArray at: 41 put: nil. "Reserved for a LinkedList instance for overlapped calls in CogMT"
- "finalization Semaphore"
- newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]).
newArray at: 43 put: LargeNegativeInteger.
"External objects for callout.
Note: Written so that one can actually completely remove the FFI."
newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
newArray at: 49 put: #aboutToReturn:through:.
newArray at: 50 put: #run:with:in:.
"51 reserved for immutability message"
+ newArray at: 51 put: #attemptToAssign:withIndex:.
- "newArray at: 51 put: #attemptToAssign:withIndex:."
- newArray at: 51 put: (self specialObjectsArray at: 51 ifAbsent: []).
newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
#'bad argument' #'bad index'
#'bad number of arguments'
#'inappropriate operation' #'unsupported operation'
#'no modification' #'insufficient object memory'
#'insufficient C memory' #'not found' #'bad method'
#'internal error in named primitive machinery'
#'object may move' #'resource limit exceeded'
+ #'object is pinned' #'primitive write beyond end of object').
- #'object is pinned').
"53 to 55 are for Alien"
newArray at: 53 put: (self at: #Alien ifAbsent: []).
+ newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
- newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
+ "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
+ newArray at: 56 put: nil.
- "Weak reference finalization"
- newArray at: 56 put: (self at: #WeakFinalizationList ifAbsent: []).
"reserved for foreign callback process"
newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
newArray at: 58 put: #unusedBytecode.
+ "59 reserved for Sista counter tripped message"
+ newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
+ "60 reserved for Sista class trap message"
+ newArray at: 60 put: #classTrapFor:.
"Now replace the interpreter's reference in one atomic operation"
+ self specialObjectsArray becomeForward: newArray!
- self specialObjectsArray becomeForward: newArray
- !
Item was changed:
----- Method: SmalltalkImage>>setGCParameters (in category 'snapshot and quit') -----
setGCParameters
+ "Adjust the VM's default GC parameters to avoid too much tenuring.
+ Maybe this should be left to the VM?"
- "Adjust the VM's default GC parameters to avoid premature tenuring."
+ | proportion edenSize survivorSize averageObjectSize numObjects |
+ proportion := 0.9. "tenure when 90% of pastSpace is full"
+ edenSize := SmalltalkImage current vmParameterAt: 44.
+ survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ averageObjectSize := 8 * self wordSize. "a good approximation"
+ numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
- self vmParameterAt: 5 put: 4000. "do an incremental GC after this many allocations"
- self vmParameterAt: 6 put: 2000. "tenure when more than this many objects survive the GC"
- !
Item was changed:
----- Method: SpaceTally>>spaceForInstancesOf: (in category 'instance size') -----
spaceForInstancesOf: aClass
+ "Answer a pair of the number of bytes consumed by all instances of the
+ given class, including their object headers, and the number of instances."
- "Answer the number of bytes consumed by all instances of the given class, including their object headers and the number of instances."
+ | instances total |
+ instances := aClass allInstances.
+ instances isEmpty ifTrue: [^#(0 0)].
- | smallHeaderSize instVarBytes isVariable bytesPerElement total lastInstance instance instanceCount |
- instance := aClass someInstance ifNil: [ ^#(0 0) ].
- smallHeaderSize := aClass isCompact ifTrue: [ 4 ] ifFalse: [ 8 ].
- instVarBytes := aClass instSize * 4.
- isVariable := aClass isVariable.
- bytesPerElement := isVariable
- ifFalse: [ 0 ]
- ifTrue: [ aClass isBytes ifTrue: [ 1 ] ifFalse: [ 4 ] ].
total := 0.
+ aClass isVariable
+ ifTrue:
+ [instances do:
+ [:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]]
+ ifFalse:
+ [total := instances size * aClass byteSizeOfInstance].
+ ^{ total. instances size }!
- instanceCount := 0.
- "A modified version of #allInstancesDo: is inlined here. It avoids an infinite loop when another process is creating new instances of aClass."
- self flag: #allInstancesDo:.
- lastInstance :=
- aClass == CompiledMethod "CompiledMethod has special format, see its class comment"
- ifTrue: [aClass new]
- ifFalse: [aClass basicNew].
- [ instance == lastInstance ] whileFalse: [
- | contentBytes headerBytes |
- contentBytes := instVarBytes + (isVariable
- ifFalse: [ 0 ]
- ifTrue: [ instance basicSize * bytesPerElement ]).
- headerBytes := contentBytes > 255
- ifTrue: [ 12 ]
- ifFalse: [ smallHeaderSize ].
- total := total + headerBytes + (contentBytes roundUpTo: 4).
- instanceCount := instanceCount + 1.
- instance := instance nextInstance ].
- ^{ total. instanceCount }!
Item was added:
+ ----- Method: SystemDictionary>>growMemoryByAtLeast: (in category 'memory space') -----
+ growMemoryByAtLeast: numBytes
+ "Grow memory by at least the requested number of bytes.
+ Primitive. Fail if no memory is available. Essential."
+ <primitive: 180>
+ ^(numBytes isInteger and: [numBytes > 0])
+ ifTrue: [OutOfMemory signal]
+ ifFalse: [self primitiveFailed]!
Item was added:
+ ----- Method: SystemDictionary>>maxIdentityHash (in category 'system attributes') -----
+ maxIdentityHash
+ "Answer the maximum identityHash value supported by the VM."
+ <primitive: 176>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SystemDictionary>>setGCParameters (in category 'snapshot and quit') -----
+ setGCParameters
+ "Adjust the VM's default GC parameters to avoid too much tenuring.
+ Maybe this should be left to the VM?"
+
+ | proportion edenSize survivorSize averageObjectSize numObjects |
+ proportion := 0.9. "tenure when 90% of pastSpace is full"
+ edenSize := SmalltalkImage current vmParameterAt: 44.
+ survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ averageObjectSize := 8 * self wordSize. "a good approximation"
+ numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
Item was added:
+ ----- Method: SystemNavigation>>allObjects (in category 'query') -----
+ allObjects
+ "Answer an Array of all objects in the system. Fail if
+ there isn't enough memory to instantiate the result."
+ <primitive: 178>
+ ^self primitiveFailed!
Item was changed:
----- Method: SystemNavigation>>allObjectsDo: (in category 'query') -----
allObjectsDo: aBlock
+ "Evaluate the argument, aBlock, for each object in the system, excluding immediates
+ such as SmallInteger and Character."
+ self allObjectsOrNil
+ ifNotNil: [:allObjects| allObjects do: aBlock]
+ ifNil:
+ ["Fall back on the old single object primitive code. With closures, this needs
+ to use an end marker (lastObject) since activation of the block will create
+ new contexts and cause an infinite loop. The lastObject must be created
+ before calling someObject, so that the VM can settle the enumeration (e.g.
+ by flushing new space) as a side effect of someObject"
+ | object lastObject |
+ lastObject := Object new.
+ object := self someObject.
+ [lastObject == object or: [0 == object]] whileFalse:
+ [aBlock value: object.
+ object := object nextObject]]!
- "Evaluate the argument, aBlock, for each object in the system
- excluding SmallIntegers. With closures, this needs to use an end
- marker (lastObject) since activation of the block will create new
- contexts and cause an infinite loop."
- | object lastObject |
- object := self someObject.
- lastObject := Object new.
- [lastObject == object or: [0 == object]]
- whileFalse: [aBlock value: object.
- object := object nextObject]!
Item was added:
+ ----- Method: SystemNavigation>>allObjectsOrNil (in category 'query') -----
+ allObjectsOrNil
+ "Answer an Array of all objects in the system. Fail if there isn't
+ enough memory to instantiate the result and answer nil."
+ <primitive: 178>
+ ^nil!
1
0
Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel.spur-ul.875.mcz
==================== Summary ====================
Name: Kernel.spur-ul.875
Author: eem
Time: 27 September 2014, 1:16:59.187 pm
UUID: 3e4a6002-9948-4f78-a687-78b70614ac74
Ancestors: Kernel-ul.875
Kernel-ul.875 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.208
- improved Date >> #printFormat:
- added #isZero to LargeIntegers
=============== Diff against Kernel-ul.875 ===============
Item was changed:
----- Method: Behavior>>allInstances (in category 'accessing instances and variables') -----
+ allInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == nil] whileFalse:
+ [next := inst nextInstance.
+ (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
+ inst := next].
+ ^insts contents!
- allInstances
- "Answer a collection of all current instances of the receiver."
-
- | all |
- all := OrderedCollection new.
- self allInstancesDo: [:x | x == all ifFalse: [all add: x]].
- ^ all asArray
- !
Item was changed:
----- Method: Behavior>>allInstancesDo: (in category 'enumerating') -----
+ allInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst."
- allInstancesDo: aBlock
- "Evaluate the argument, aBlock, for each of the current instances of the
- receiver.
-
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst."
- | inst next |
inst := self someInstance.
+ [inst == nil] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
- [inst == nil]
- whileFalse:
- [
- next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was added:
+ ----- Method: Behavior>>allInstancesOrNil (in category 'enumerating') -----
+ allInstancesOrNil
+ "Answer all instances of the receiver, or nil if the primitive
+ fails, which it may be due to being out of memory."
+ <primitive: 177>
+ ^nil!
Item was changed:
----- Method: Behavior>>basicNew (in category 'instance creation') -----
basicNew
"Primitive. Answer an instance of the receiver (which is a class) with no
+ indexable variables. Fail if the class is indexable. Essential. See Object
+ documentation whatIsAPrimitive.
+
+ If the primitive fails because space is low then the scavenger will run
+ before the method is activated. Check that space was low and retry
+ via handleFailingBasicNew if so."
- indexable variables. Fail if the class is indexable. Essential. See Object
- documentation whatIsAPrimitive."
+ <primitive: 70 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingBasicNew].
+ self isVariable ifTrue: [^self basicNew: 0].
+ self primitiveFailed!
- <primitive: 70>
- self isVariable ifTrue: [ ^ self basicNew: 0 ].
- "space must be low"
- OutOfMemory signal.
- ^ self basicNew "retry if user proceeds"
- !
Item was changed:
----- Method: Behavior>>basicNew: (in category 'instance creation') -----
+ basicNew: sizeRequested
+ "Primitive. Answer an instance of this class with the number of indexable
+ variables specified by the argument, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive.
+
+ If the primitive fails because space is low then the scavenger will run before the
+ method is activated. Check args and retry via handleFailingBasicNew: if they're OK."
- basicNew: sizeRequested
- "Primitive. Answer an instance of this class with the number
- of indexable variables specified by the argument, sizeRequested.
- Fail if this class is not indexable or if the argument is not a
- positive Integer, or if there is not enough memory available.
- Essential. See Object documentation whatIsAPrimitive."
+ <primitive: 71 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingBasicNew: sizeRequested].
- <primitive: 71>
self isVariable ifFalse:
[self error: self printString, ' cannot have variable sized instances'].
- (sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue:
- ["arg okay; space must be low."
- OutOfMemory signal.
- ^ self basicNew: sizeRequested "retry if user proceeds"].
self primitiveFailed!
Item was added:
+ ----- Method: Behavior>>byteSizeOfInstance (in category 'accessing instances and variables') -----
+ byteSizeOfInstance
+ "Answer the total memory size of an instance of the receiver."
+
+ <primitive: 181 error: ec>
+ self isVariable ifTrue:
+ [^self byteSizeOfInstanceOfSize: 0].
+ self primitiveFailed!
Item was added:
+ ----- Method: Behavior>>byteSizeOfInstanceOfSize: (in category 'accessing instances and variables') -----
+ byteSizeOfInstanceOfSize: basicSize
+ "Answer the total memory size of an instance of the receiver
+ with the given number of indexable instance variables."
+
+ <primitive: 181 error: ec>
+ self isVariable
+ ifTrue: "If the primitive overflowed answer a close approximation"
+ [(basicSize isInteger
+ and: [basicSize >= 16r1000000]) ifTrue:
+ [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
+ - (self byteSizeOfInstanceOfSize: 0)]]
+ ifFalse:
+ [basicSize = 0 ifTrue:
+ [^self byteSizeOfInstance]].
+ self primitiveFailed!
Item was added:
+ ----- 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 (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 added:
+ ----- Method: Behavior>>handleFailingBasicNew (in category 'private') -----
+ handleFailingBasicNew
+ "handleFailingBasicNew gets sent after basicNew 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 70>
+ Smalltalk garbageCollect < 1048576 ifTrue:
+ [Smalltalk growMemoryByAtLeast: 1048576].
+ ^self handleFailingFailingBasicNew "retry after global garbage collect"!
Item was added:
+ ----- Method: Behavior>>handleFailingBasicNew: (in category 'private') -----
+ handleFailingBasicNew: sizeRequested
+ "handleFailingBasicNew: gets sent after basicNew: 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 71>
+ | bytesRequested |
+ bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
+ Smalltalk garbageCollect < bytesRequested ifTrue:
+ [Smalltalk growMemoryByAtLeast: bytesRequested].
+ "retry after global garbage collect and possible grow"
+ ^self handleFailingFailingBasicNew: sizeRequested!
Item was added:
+ ----- Method: Behavior>>handleFailingFailingBasicNew (in category 'private') -----
+ handleFailingFailingBasicNew
+ "This basicNew 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 70>
+ "space must be low"
+ OutOfMemory signal.
+ ^self basicNew "retry if user proceeds"!
Item was added:
+ ----- Method: Behavior>>handleFailingFailingBasicNew: (in category 'private') -----
+ handleFailingFailingBasicNew: sizeRequested
+ "This basicNew: 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 71>
+ "space must be low."
+ OutOfMemory signal.
+ ^self basicNew: sizeRequested "retry if user proceeds"!
Item was added:
+ ----- Method: Behavior>>identityHash (in category 'comparing') -----
+ identityHash
+ "Answer a SmallInteger whose value is related to the receiver's identity.
+ Behavior implements identityHash to allow the VM to use an object representation which
+ does not include a direct reference to an object's class in an object. If the VM is using
+ this implementation then classes are held in a class table and instances contain the index
+ of their class in the table. A class's class table index is its identityHash so that an instance
+ can be created without searching the table for a class's index. The VM uses this primitive
+ to enter the class into the class table, assigning its identityHash with an as yet unused
+ class table index. If this primitive fails it means that the class table is full. In Spur as of
+ 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
+
+ Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
+
+ <primitive: 175>
+ self primitiveFailed!
Item was changed:
----- Method: Behavior>>indexIfCompact (in category 'private') -----
indexIfCompact
+ "Backward compatibility with the Squeak V3 object format.
+ Spur does not have a distinction between compact and non-compact classes."
+ ^0!
- "If these 5 bits are non-zero, then instances of this class
- will be compact. It is crucial that there be an entry in
- Smalltalk compactClassesArray for any class so optimized.
- See the msgs becomeCompact and becomeUncompact."
- ^ (format bitShift: -11) bitAnd: 16r1F
- "
- Smalltalk compactClassesArray doWithIndex:
- [:c :i | c == nil ifFalse:
- [c indexIfCompact = i ifFalse: [self halt]]]
- "!
Item was changed:
----- Method: Behavior>>instSize (in category 'testing') -----
instSize
"Answer the number of named instance variables
+ (as opposed to indexed variables) of the receiver.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>"
+ ^format bitAnd: 16rFFFF!
- (as opposed to indexed variables) of the receiver."
-
- self flag: #instSizeChange. "Smalltalk browseAllCallsOn: #instSizeChange"
- "
- NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
- When we revise the image format, it should become...
- ^ ((format bitShift: -1) bitAnd: 16rFF) - 1
- Note also that every other method in this category will require
- 2 bits more of right shift after the change.
- "
- ^ ((format bitShift: -10) bitAnd: 16rC0) + ((format bitShift: -1) bitAnd: 16r3F) - 1!
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 (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)"
+ ^(format bitShift: -16) bitAnd: 16r1F!
- ^ (format bitShift: -7) bitAnd: 16rF!
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 (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!
- "Answer whether the receiver contains just bits (not pointers)."
-
- ^ self instSpec >= 6!
Item was changed:
----- Method: Behavior>>isBytes (in category 'testing') -----
isBytes
+ "Answer whether the receiver has 8-bit 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 (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!
- "Answer whether the receiver has 8-bit instance variables."
-
- ^ self instSpec >= 8!
Item was added:
+ ----- Method: Behavior>>isEphemeronClass (in category 'testing') -----
+ isEphemeronClass
+ "Answer whether the receiver has ephemeral instance variables. The garbage collector will
+ fire (queue for finalization) any ephemeron whose first instance variable is not referenced
+ other than from the transitive closure of references from ephemerons. Hence referring to
+ an object from the first inst var of an ephemeron will cause the ephemeron to fire when
+ the rest of the system does not refer to the object and that object is ready to be collected.
+ Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
+ from firing, ephemerons may act as the associations in weak dictionaries such that the value
+ (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
+ other than from ephemerons. Ephemerons can therefore be used to implement instance-based
+ pre-mortem finalization."
+ ^self instSpec = 5!
Item was added:
+ ----- Method: Behavior>>isImmediateClass (in category 'testing') -----
+ isImmediateClass
+ "Answer whether the receiver has immediate instances. Immediate instances
+ store their value in their object pointer, not in an object body. Hence immediates
+ take no space and are immutable. The immediates are distinguished by tag bits
+ in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit
+ system SmallIntegers are 31-bit signed integers and Characters are 30-bit
+ unsigned character codes."
+ ^self instSpec = 7!
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 (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]]!
- "Answer whether the receiver has indexable variables."
-
- ^ self instSpec >= 2!
Item was changed:
----- Method: Behavior>>kindOfSubclass (in category 'testing class hierarchy') -----
kindOfSubclass
+ "Answer a String that is the keyword that describes the receiver's kind of subclass,
+ either a regular subclass, a variableSubclass, a variableByteSubclass,
+ a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
+ c.f. typeOfClass"
+ ^self isVariable
+ ifTrue:
+ [self isBits
+ ifTrue:
+ [self isBytes
+ ifTrue: [' variableByteSubclass: ']
+ ifFalse: [' variableWordSubclass: ']]
+ ifFalse:
+ [self isWeak
+ ifTrue: [' weakSubclass: ']
+ ifFalse: [' variableSubclass: ']]]
+ ifFalse:
+ [self isImmediateClass
+ ifTrue: [' immediateSubclass: ']
+ ifFalse:
+ [self isEphemeronClass
+ ifTrue: [' ephemeronSubclass: ']
+ ifFalse: [' subclass: ']]]!
- "Answer a String that is the keyword that describes the receiver's kind
- of subclass, either a regular subclass, a variableSubclass, a
- variableByteSubclass, a variableWordSubclass, or a weakSubclass."
- self isWeak
- ifTrue: [^ ' weakSubclass: '].
- ^ self isVariable
- ifTrue: [self isBits
- ifTrue: [self isBytes
- ifTrue: [ ' variableByteSubclass: ']
- ifFalse: [ ' variableWordSubclass: ']]
- ifFalse: [ ' variableSubclass: ']]
- ifFalse: [ ' subclass: ']!
Item was changed:
----- Method: Behavior>>shouldNotBeRedefined (in category 'testing') -----
shouldNotBeRedefined
+ "Answer if the receiver should not be redefined.
+ The assumption is that classes in Smalltalk specialObjects and
+ instance-specific Behaviors should not be redefined"
- "Return true if the receiver should not be redefined.
- The assumption is that compact classes,
- classes in Smalltalk specialObjects and
- Behaviors should not be redefined"
+ ^(Smalltalk specialObjectsArray
+ identityIndexOf: self
+ ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!
- ^(Smalltalk compactClassesArray includes: self)
- or:[(Smalltalk specialObjectsArray includes: self)
- or:[self isKindOf: self]]!
Item was changed:
----- Method: Behavior>>typeOfClass (in category 'accessing') -----
typeOfClass
+ "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass"
+ self isBytes ifTrue:
+ [^self instSpec = CompiledMethod instSpec
+ ifTrue: [#compiledMethod] "Very special!!"
+ ifFalse: [#bytes]].
+ (self isWords and: [self isPointers not]) ifTrue:
+ [^self instSpec = SmallInteger instSpec
+ ifTrue: [#immediate] "Very special!!"
+ ifFalse: [#words]].
+ self isWeak ifTrue: [^#weak].
+ self isVariable ifTrue: [^#variable].
+ self isEphemeronClass ifTrue: [^#ephemeron].
+ ^#normal!
- "Answer a symbol uniquely describing the type of the receiver"
- self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!"
- self isBytes ifTrue:[^#bytes].
- (self isWords and:[self isPointers not]) ifTrue:[^#words].
- self isWeak ifTrue:[^#weak].
- self isVariable ifTrue:[^#variable].
- ^#normal.!
Item was changed:
----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') -----
simulateValueWithArguments: anArray caller: aContext
+ "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
| newContext sz |
- (anArray class ~~ Array
- or: [numArgs ~= anArray size]) ifTrue:
- [^ContextPart primitiveFailTokenFor: nil].
newContext := (MethodContext newForMethod: outerContext method)
setSender: aContext
receiver: outerContext receiver
method: outerContext method
closure: self
startpc: startpc.
+ ((newContext objectClass: anArray) ~~ Array
+ or: [numArgs ~= anArray size]) ifTrue:
+ [^ContextPart primitiveFailTokenFor: nil].
sz := self basicSize.
newContext stackp: sz + numArgs.
1 to: numArgs do:
[:i| newContext at: i put: (anArray at: i)].
1 to: sz do:
[:i| newContext at: i + numArgs put: (self at: i)].
^newContext!
Item was added:
+ ----- Method: Class>>immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
+ immediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new
+ immediate class as a subclass of an existing class (the receiver)."
+ ^ClassBuilder new
+ superclass: self
+ immediateSubclass: t
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was changed:
----- Method: ClassBuilder>>computeFormat:instSize:forSuper:ccIndex: (in category 'class format') -----
computeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
"Compute the new format for making oldClass a subclass of newSuper.
+ Answer the format or nil if there is any problem."
- Return the format or nil if there is any problem."
| instSize isVar isWords isPointers isWeak |
type == #compiledMethod ifTrue:
+ [newInstSize > 0 ifTrue:
+ [self error: 'A compiled method class cannot have named instance variables'.
+ ^nil].
+ ^CompiledMethod format].
- [^(CompiledMethod format
- bitClear: (16r1F bitShift: 11))
- bitOr: (ccIndex bitShift: 11)].
instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
+ instSize > 65535 ifTrue:
- instSize > 254 ifTrue:
[self error: 'Class has too many instance variables (', instSize printString,')'.
^nil].
type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
+ type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
+ type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
+ (isPointers not and: [instSize > 0]) ifTrue:
+ [self error: 'A non-pointer class cannot have named instance variables'.
- (isPointers not and:[instSize > 0]) ifTrue:
- [self error:'A non-pointer class cannot have instance variables'.
^nil].
+ ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
- ^(self format: instSize
- variable: isVar
- words: isWords
- pointers: isPointers
- weak: isWeak) + (ccIndex bitShift: 11).!
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 (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 |
- format: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
- "Compute the format for the given instance specfication."
- | cClass instSpec sizeHiBits fmt |
- self flag: #instSizeChange.
- "
- Smalltalk browseAllCallsOn: #instSizeChange.
- Smalltalk browseAllImplementorsOf: #fixedFieldsOf:.
- Smalltalk browseAllImplementorsOf: #instantiateClass:indexableSize:.
- "
- "
- NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
- For now the format word is...
- <2 bits=instSize//64><5 bits=cClass><4 bits=instSpec><6 bits=instSize\\64><1 bit=0>
- But when we revise the image format, it should become...
- <5 bits=cClass><4 bits=instSpec><8 bits=instSize><1 bit=0>
- "
- sizeHiBits := (nInstVars+1) // 64.
- cClass := 0. "for now"
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!
- ifTrue:[4]
- ifFalse:[isPointers
- ifTrue: [isVar
- ifTrue: [nInstVars>0 ifTrue: [3] ifFalse: [2]]
- ifFalse: [nInstVars>0 ifTrue: [1] ifFalse: [0]]]
- ifFalse: [isWords ifTrue: [6] ifFalse: [8]]].
- fmt := sizeHiBits.
- fmt := (fmt bitShift: 5) + cClass.
- fmt := (fmt bitShift: 4) + instSpec.
- fmt := (fmt bitShift: 6) + ((nInstVars+1)\\64). "+1 since prim size field includes header"
- fmt := (fmt bitShift: 1). "This shift plus integer bit lets wordSize work like byteSize"
- ^fmt!
Item was added:
+ ----- Method: ClassBuilder>>superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
+ superclass: aClass
+ immediateSubclass: t instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a
+ new immediate class as a subclass of an existing class."
+ | env |
+ aClass instSize > 0
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
+ aClass isVariable
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
+ aClass isPointers
+ ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
+ "Cope with pre-environment and environment versions. Simplify asap."
+ env := (Smalltalk classNamed: #EnvironmentRequest)
+ ifNil: [aClass environment]
+ ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
+ ^self
+ name: t
+ inEnvironment: env
+ subclassOf: aClass
+ type: #immediate
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was changed:
----- Method: ClassBuilder>>update:to: (in category 'class mutation') -----
update: oldClass to: newClass
+ "Convert oldClass, all its instances and possibly its meta class into newClass,
+ instances of newClass and possibly its meta class. The process is surprisingly
+ simple in its implementation and surprisingly complex in its nuances and potentially
+ bad side effects.
+ We can rely on two assumptions (which are critical):
+ #1: The method #updateInstancesFrom: will not create any lasting pointers to
+ 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
+ a become of the old vs. the new instances and therefore it will not create
+ pointers to *new* instances before the #become: which are *old* afterwards)
+ #2: The non-preemptive execution of the critical piece of code guarantees that
+ nobody can get a hold by 'other means' (such as process interruption and
+ reflection) on the old instances.
+ Given the above two, we know that after #updateInstancesFrom: there are no pointers
+ to any old instances. After the forwarding become there will be no pointers to the old
+ class or meta class either.
+ Andreas Raab, 2/27/2003 23:42"
- "Convert oldClass, all its instances and possibly its meta class into newClass, instances of newClass and possibly its meta class. The process is surprisingly simple in its implementation and surprisingly complex in its nuances and potentially bad side effects.
- We can rely on two assumptions (which are critical):
- #1: The method #updateInstancesFrom: will not create any lasting pointers to 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do a become of the old vs. the new instances and therefore it will not create pointers to *new* instances before the #become: which are *old* afterwards)
- #2: The non-preemptive execution of the critical piece of code guarantees that nobody can get a hold by 'other means' (such as process interruption and reflection) on the old instances.
- Given the above two, we know that after #updateInstancesFrom: there are no pointer to any old instances. After the forwarding become there will be no pointers to the old class or meta class either. Meaning that if we throw in a nice fat GC at the end of the critical block, everything will be gone (but see the comment right there). There's no need to worry.
- "
| meta |
meta := oldClass isMeta.
"Note: Everything from here on will run without the ability to get interrupted
to prevent any other process to create new instances of the old class."
+ ["Note: The following removal may look somewhat obscure and needs an explanation.
+ When we mutate the class hierarchy we create new classes for any existing subclass.
+ So it may look as if we don't have to remove the old class from its superclass. However,
+ at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
+ created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
+ subclasses. Since the #become: below will transparently replace the pointers to oldClass
+ with newClass the superclass would have newClass in its subclasses TWICE. With rather
+ unclear effects if we consider that we may convert the meta-class hierarchy itself (which
+ is derived from the non-meta class hierarchy).
+ Due to this problem ALL classes are removed from their superclass just prior to converting
+ them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
+ effectively remove the oldClass (becomeForward:) just a few lines below."
- [
- "Note: The following removal may look somewhat obscure and needs an explanation. When we mutate the class hierarchy we create new classes for any existing subclass. So it may look as if we don't have to remove the old class from its superclass. However, at the top of the hierarchy (the first class we reshape) that superclass itself is not newly created so therefore it will hold both the oldClass and newClass in its (obsolete or not) subclasses. Since the #become: below will transparently replace the pointers to oldClass with newClass the superclass would have newClass in its subclasses TWICE. With rather unclear effects if we consider that we may convert the meta-class hierarchy itself (which is derived from the non-meta class hierarchy).
- Due to this problem ALL classes are removed from their superclass just prior to converting them. Here, breaking the superclass/subclass invariant really doesn't matter since we will effectively remove the oldClass (become+GC) just a few lines below."
oldClass superclass removeSubclass: oldClass.
oldClass superclass removeObsoleteSubclass: oldClass.
"make sure that the VM cache is clean"
oldClass methodDict do: [:cm | cm flushCache].
"Convert the instances of oldClass into instances of newClass"
newClass updateInstancesFrom: oldClass.
meta
ifTrue:
[oldClass becomeForward: newClass.
oldClass updateMethodBindingsTo: oldClass binding]
ifFalse:
[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
oldClass updateMethodBindingsTo: oldClass binding.
oldClass class updateMethodBindingsTo: oldClass class binding].
+ "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
+ to ensure no old instances existed after the becomeForward:. Without the GC it was possible
+ to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
+ updated references from the old objects to new objects but didn't destroy the old objects.
+ But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
+ valueUnpreemptively!
- Smalltalk garbageCollect.
-
- "Warning: Read this before you even think about removing the GC. Yes, it slows us down. Quite heavily if you have a large image. However, there's no good and simple alternative here, since unfortunately, #become: does change class pointers. What happens is that after the above become all of the instances of the old class will have a class pointer identifying them as instances of newClass. If we get our hands on any of these instances we will break immediately since their expected instance layout (that of its class, e.g., newClass) will not match their actual instance layout (that of oldClass). And getting your hands on any of those instances is really simple - just reshaping one class two times in rapid succession will do it. Reflection techniques, interrupts, etc. will only add to this problem. In the case of Metaclass things get even worse since when we recompile the entire class hierarchy we will recompile both, Metaclass and its instances (and some of its instances will have the old and some the new layout).
-
- The only easy solution to this problem would be to 'fix up' the class pointers of the old instances to point to the old class (using primitiveChangeClassTo:). But this won't work either - as we do a one-way become we would have to search the entire object memory for the oldClass and couldn't even clearly identify it unless we give it some 'special token' which sounds quite error-prone. If you really need to get rid of the GC here are some alternatives:
-
- On the image level, one could create a copy of the oldClass before becoming it into the new class and, after becoming it, 'fix up' the old instances. That would certainly work but it sounds quite complex, as we need to make sure we're not breaking any of the superclass/subclass meta/non-meta class variants.
-
- Alternatively, fix up #becomeForward on the VM-level to 'dump the source objects' of #become. This would be quite doable (just 'convert' them into a well known special class such as bitmap) yet it has problems if (accidentally or not) one of the objects in #become: appears on 'both sides of the fence' (right now, this will work ... in a way ... even though the consequences are unclear).
-
- Another alternative is to provide a dedicated primitive for this (instead of using it implicitly in become) which would allow us to dump all the existing instances right here. This is equivalent to a more general primitiveChangeClassTo: and might be worthwhile but it would likely have to keep in mind the differences between bits and pointer thingies etc.
-
- Since all of the alternatives seem rather complex and magical compared to a straight-forward GC it seems best to stick with the GC solution for now. If someone has a real need to fix this problem, that person will likely be motivated enough to check out the alternatives. Personally I'd probably go for #1 (copy the old class and remap the instances to it) since it's a solution that could be easily reverted from within the image if there's any problem with it."
-
- ] valueUnpreemptively.
- !
Item was changed:
ByteArray variableByteSubclass: #CompiledMethod
instanceVariableNames: ''
classVariableNames: 'LargeFrame PrimaryBytecodeSetEncoderClass SecondaryBytecodeSetEncoderClass SmallFrame'
poolDictionaries: ''
category: 'Kernel-Methods'!
+ !CompiledMethod commentStamp: 'eem 8/12/2014 14:45' prior: 0!
+ CompiledMethod instances are methods suitable for interpretation by the virtual machine. Instances of CompiledMethod and its subclasses are the only objects in the system that have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. CompiledMethod inherits from ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray.
- !CompiledMethod commentStamp: 'eem 5/12/2014 18:02' prior: 0!
- My instances are methods suitable for interpretation by the virtual machine. This is the only class in the system whose instances have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. I'm a subclass of ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray.
Class variables:
SmallFrame - the number of stack slots in a small frame Context
LargeFrame - the number of stack slots in a large frame Context
PrimaryBytecodeSetEncoderClass - the encoder class that defines the primary instruction set
SecondaryBytecodeSetEncoderClass - the encoder class that defines the secondary instruction set
The current format of a CompiledMethod is as follows:
header (4 or 8 bytes, SmallInteger)
+ literals (4 or 8 bytes each, Object, see "The last literal..." below)
- literals (4 or 8 bytes each, Object)
bytecodes (variable, bytes)
trailer (variable, bytes)
+ The header is a 31-bit signed integer (a SmallInteger) in the following format:
- The header is a 31-bit signed integer (a SmallInteger) with one of the two following formats, selected by the sign bit:
- sign bit 0, header >= 0:
- (index 0) 9 bits: main part of primitive number (#primitive)
- (index 9) 8 bits: number of literals (#numLiterals)
- (index 17) 1 bit: whether a large frame size is needed (#frameSize)
- (index 18) 6 bits: number of temporary variables (#numTemps)
- (index 24) 4 bits: number of arguments to the method (#numArgs)
- (index 28) 1 bit: high-bit of primitive number (#primitive)
- (index 29) 1 bit: flag bit, ignored by the VM (#flag)
- (index 30/63) sign bit: 0 selects the Primary instruction set (#signFlag)
- sign bit 1, header < 0:
(index 0) 16 bits: number of literals (#numLiterals)
(index 16) 1 bit: has primitive
+ (index 17) 1 bit: whether a large frame size is needed (#frameSize => either SmallFrame or LargeFrame)
- (index 17) 1 bit: whether a large frame size is needed (#frameSize)
(index 18) 6 bits: number of temporary variables (#numTemps)
(index 24) 4 bits: number of arguments to the method (#numArgs)
+ (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public), although accessors for bit 29 exist (see #flag).
+ (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4, 0 selects the primary instruction set, e.g. SqueakV3PlusClosures) (#signFlag)
- (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public)
- (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4) (#signFlag)
- i.e. the Secondary Bytecode Set expands the number of literals to 65535 by assuming a CallPrimitive bytecode.
+ If the method has a primitive then the first bytecode of the method must be a callPrimitive: bytecode that encodes the primitive index.
+
+ The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.
+
+ The last literal in a CompiledMethod must be its methodClassAssociation, a binding whose value is the class the method is installed in. The methodClassAssociation is used to implement super sends. If a method contains no super send then its methodClassAssociation may be left nil (as would be the case for example of methods providing a pool of inst var accessors). By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState. AdditionalMethodState holds any pragmas and properties of a method, but may also be used to add instance variables to a method, albeit ones held in the method's AdditionalMethodState. Subclasses of CompiledMethod that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledMethod subclass to answer the specialized subclass of AdditionalMethodState.!
- The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.!
Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 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."
+ | method pc |
+ nArgs > 15 ifTrue:
+ [^self error: 'Cannot compile -- too many arguments'].
- | largeBit primBits |
nTemps > 63 ifTrue:
+ [^self error: 'Cannot compile -- too many temporary variables'].
+ nLits > 65535 ifTrue:
+ [^self error: 'Cannot compile -- too many literals'].
- [^ self error: 'Cannot compile -- too many temporary variables'].
- nLits > 255 ifTrue:
- [^ self error: 'Cannot compile -- too many literals'].
- 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)].
+ 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!
- ^trailer
- createMethod: numberOfBytes
- class: self
- header: (nArgs bitShift: 24) +
- (nTemps bitShift: 18) +
- (largeBit bitShift: 17) +
- (nLits bitShift: 9) +
- 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."
+ | method pc |
+ nArgs > 15 ifTrue:
+ [^self error: 'Cannot compile -- too many arguments'].
- | largeBit primBits flagBit |
nTemps > 63 ifTrue:
+ [^self error: 'Cannot compile -- too many temporary variables'].
+ nLits > 65535 ifTrue:
+ [^self error: 'Cannot compile -- too many literals'].
- [^ self error: 'Cannot compile -- too many temporary variables'].
- nLits > 255 ifTrue:
- [^ self error: 'Cannot compile -- too many literals'].
- largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0].
+ 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!
- "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 ].
-
- ^trailer
- createMethod: numberOfBytes
- class: self
- header: (nArgs bitShift: 24) +
- (nTemps bitShift: 18) +
- (largeBit bitShift: 17) +
- (nLits bitShift: 9) +
- primBits +
- (flagBit bitShift: 29)!
Item was changed:
----- Method: CompiledMethod class>>newMethod:header: (in category 'instance creation') -----
+ newMethod: numberOfBytes header: headerWord
- 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."
- information) is specified the headerWord. 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. Once
- the header of a method is set by this primitive, it cannot be changed in
- any way. Essential. See Object documentation whatIsAPrimitive."
+ <primitive: 79 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingNewMethod: numberOfBytes header: headerWord].
- <primitive: 79>
- (numberOfBytes isInteger and:
- [headerWord isInteger and:
- [numberOfBytes >= 0]]) ifTrue: [
- "args okay; space must be low"
- OutOfMemory signal.
- "retry if user proceeds"
- ^ self newMethod: numberOfBytes header: headerWord
- ].
^self primitiveFailed!
Item was changed:
----- Method: CompiledMethod class>>toReturnConstant:trailerBytes: (in category 'instance creation') -----
toReturnConstant: index trailerBytes: trailer
"Answer an instance of me that is a quick return of the constant
indexed in (true false nil -1 0 1 2)."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index
- !
Item was changed:
----- Method: CompiledMethod class>>toReturnField:trailerBytes: (in category 'instance creation') -----
toReturnField: field trailerBytes: trailer
"Answer an instance of me that is a quick return of the instance variable
indexed by the argument, field."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field
- !
Item was changed:
----- Method: CompiledMethod class>>toReturnSelfTrailerBytes: (in category 'instance creation') -----
toReturnSelfTrailerBytes: trailer
"Answer an instance of me that is a quick return of the instance (^self)."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256
- !
Item was added:
+ ----- Method: CompiledMethod>>bytecodeSetName (in category 'accessing') -----
+ bytecodeSetName
+ ^self encoderClass name copyReplaceAll: 'EncoderFor' with: ''!
Item was changed:
----- Method: CompiledMethod>>headerDescription (in category 'literals') -----
headerDescription
+ "Answer a description containing the information about the form of the
+ receiver and the form of the context needed to run the receiver."
- "Answer a description containing the information about the form of the
- receiver and the form of the context needed to run the receiver."
+ ^(ByteString new: 128) writeStream
+ print: self header; cr;
+ nextPutAll: '"primitive: '; print: self primitive; cr;
+ nextPutAll: ' numArgs: '; print: self numArgs; cr;
+ nextPutAll: ' numTemps: '; print: self numTemps; cr;
+ nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
+ nextPutAll: ' frameSize: '; print: self frameSize; cr;
+ nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
+ nextPut: $"; cr;
+ contents!
- | s |
- s := '' writeStream.
- self header printOn: s.
- s cr; nextPutAll: '"primitive: '.
- self primitive printOn: s.
- s cr; nextPutAll: ' numArgs: '.
- self numArgs printOn: s.
- s cr; nextPutAll: ' numTemps: '.
- self numTemps printOn: s.
- s cr; nextPutAll: ' numLiterals: '.
- self numLiterals printOn: s.
- s cr; nextPutAll: ' frameSize: '.
- self frameSize printOn: s.
- s cr; nextPutAll: ' isClosureCompiled: '.
- self isBlueBookCompiled not printOn: s.
- s nextPut: $"; cr.
- ^ s contents!
Item was changed:
----- Method: CompiledMethod>>numLiterals (in category 'accessing') -----
numLiterals
"Answer the number of literals used by the receiver."
+ ^self header bitAnd: 65535!
- | header |
- ^(header := self header) < 0
- ifTrue: [header bitAnd: 65535]
- ifFalse: [(header bitShift: -9) bitAnd: 16rFF]!
Item was changed:
----- Method: CompiledMethod>>primitive (in category 'accessing') -----
primitive
"Answer the primitive index associated with the receiver.
+ Zero indicates that this is not a primitive method."
+ | initialPC |
+ ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
+ ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
+ ifFalse: [0]!
- Zero indicates that this is not a primitive method.
- In the original header format we currently allow 10 bits of primitive index, but they are
- in two places for backward compatibility. In the new format the primitive index is in the
- last two bytes of a three byte callPrimitive: bytecode. The time to unpack is negligible,
- since the derived primitive function pointer full index is stored in the method cache."
- | header initialPC |
- ^(header := self header) < 0
- ifTrue:
- [(header anyMask: 65536) "Is the hasPrimitive? flag set?"
- ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
- ifFalse: [0]]
- ifFalse:
- [(header bitAnd: 16r1FF) + ((header bitShift: -19) bitAnd: 16r200)]!
Item was changed:
----- Method: ContextPart>>activateReturn:value: (in category 'private') -----
activateReturn: aContext value: value
"Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
+ ^MethodContext
+ sender: self
- ^ self
- activateMethod: ContextPart theReturnMethod
- withArgs: {value}
receiver: aContext
+ method: MethodContext theReturnMethod
+ arguments: {value}!
- class: aContext class!
Item was changed:
----- Method: ContextPart>>doPrimitive:method:receiver:args: (in category 'private') -----
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
+ "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and
+ arguments are given as arguments to this message. If successful, push result and return
+ resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
+ execution needs to be intercepted and simulated to avoid execution running away."
- "Simulate a primitive method whose index is primitiveIndex. The
- simulated receiver and arguments are given as arguments to this message.
- If successful, push result and return resuming context, else ^ PrimitiveFailToken.
- Any primitive which provokes execution needs to be intercepted and simulated
- to avoid execution running away."
| value |
"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
the debugger from entering various run-away activities such as spawning a new
process, etc. Injudicious use results in the debugger not being able to debug
+ interesting code, such as the debugger itself. hence use primitive 19 with care :-)"
- interesting code, such as the debugger itself. hence use primtiive 19 with care :-)"
"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
primitiveIndex = 19 ifTrue:
[ToolSet
debugContext: self
label:'Code simulation error'
contents: nil].
+ ((primitiveIndex between: 201 and: 222)
+ and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
+ [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
+ or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
+ [^receiver simulateValueWithArguments: arguments caller: self].
+ primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
+ [^receiver simulateValueWithArguments: arguments first caller: self]].
- "ContextPart>>blockCopy:; simulated to get startpc right"
- (primitiveIndex = 80 and: [(self objectClass: receiver) includesBehavior: ContextPart])
- ifTrue: [^self push: ((BlockContext newForMethod: receiver method)
- home: receiver home
- startpc: pc + 2
- nargs: (arguments at: 1))].
- (primitiveIndex = 81 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>value[:value:...]"
- ifTrue: [^receiver pushArgs: arguments from: self].
- (primitiveIndex = 82 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>valueWithArguments:"
- ifTrue: [^receiver pushArgs: arguments first from: self].
- primitiveIndex = 83 "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
- ifTrue: [^self send: arguments first
- to: receiver
- with: arguments allButFirst
- super: false].
- primitiveIndex = 84 "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
- ifTrue: [^self send: arguments first
- to: receiver
- with: (arguments at: 2)
- startClass: nil].
- primitiveIndex = 100 "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
- ifTrue: [^self send: arguments first
- to: receiver
- with: (arguments at: 2)
- startClass: (arguments at: 3)].
+ primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
+ [^self send: arguments first to: receiver with: arguments allButFirst super: false].
+ primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
+ [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
+ primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
+ [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
+
"Mutex>>primitiveEnterCriticalSection
Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
[| active effective |
active := Processor activeProcess.
effective := active effectiveProcess.
"active == effective"
value := primitiveIndex = 186
ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
+ ^(self isPrimFailToken: value)
- ^((self objectClass: value) == Array
- and: [value size = 2
- and: [value first == PrimitiveFailToken]])
ifTrue: [value]
ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
[^MethodContext
sender: self
receiver: receiver
method: (arguments at: 2)
arguments: (arguments at: 1)].
"Closure primitives"
(primitiveIndex = 200 and: [self == receiver]) ifTrue:
"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
[^self push: (BlockClosure
outerContext: receiver
startpc: pc + 2
numArgs: arguments first
copiedValues: arguments last)].
- ((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
- or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
- [^receiver simulateValueWithArguments: arguments caller: self].
- primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
- [^receiver simulateValueWithArguments: arguments first caller: self].
primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
[(arguments size = 2
and: [arguments first isInteger
and: [(self objectClass: arguments last) == Array]]) ifFalse:
[^ContextPart primitiveFailTokenFor: nil].
^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method"
ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
ifFalse:
[primitiveIndex = 117 "named primitives"
ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
+ ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
+
+ ^(self isPrimFailToken: value)
- ifFalse:
- [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
- ^((self objectClass: value) == Array
- and: [value size = 2
- and: [value first == PrimitiveFailToken]])
ifTrue: [value]
ifFalse: [self push: value]!
Item was added:
+ ----- Method: ContextPart>>isPrimFailToken: (in category 'private') -----
+ isPrimFailToken: anObject
+ ^(self objectClass: anObject) == Array
+ and: [anObject size = 2
+ and: [anObject first == PrimitiveFailToken]]!
Item was added:
+ ----- Method: ContextPart>>send:to:with:lookupIn: (in category 'controlling') -----
+ send: selector to: rcvr with: arguments lookupIn: lookupClass
+ "Simulate the action of sending a message with selector and arguments
+ to rcvr. The argument, lookupClass, is the class in which to lookup the
+ message. This is the receiver's class for normal messages, but for super
+ messages it will be some specific class related to the source method."
+
+ | meth primIndex val ctxt |
+ (meth := lookupClass lookupSelector: selector) ifNil:
+ [^self send: #doesNotUnderstand:
+ to: rcvr
+ with: {Message selector: selector arguments: arguments}
+ lookupIn: lookupClass].
+ (primIndex := meth primitive) > 0 ifTrue:
+ [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
+ (self isPrimFailToken: val) ifFalse:
+ [^val]].
+ (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
+ [^self error: 'Simulated message ', arguments first selector, ' not understood'].
+ ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
+ primIndex > 0 ifTrue:
+ [ctxt failPrimitiveWith: val].
+ ^ctxt!
Item was changed:
----- Method: ContextPart>>send:to:with:super: (in category 'controlling') -----
+ send: selector to: rcvr with: arguments super: superFlag
+ "Simulate the action of sending a message with selector arguments
+ to rcvr. The argument, superFlag, tells whether the receiver of the
+ message was specified with 'super' in the source method."
- send: selector to: rcvr with: args super: superFlag
- "Simulate the action of sending a message with selector, selector, and
- arguments, args, to receiver. The argument, superFlag, tells whether the
- receiver of the message was specified with 'super' in the source method."
+ ^self send: selector
+ to: rcvr
+ with: arguments
+ lookupIn: (superFlag
+ ifTrue: [self method methodClassAssociation value superclass]
+ ifFalse: [self objectClass: rcvr])!
- | class meth val ctxt |
- class := superFlag
- ifTrue: [self method methodClassAssociation value superclass]
- ifFalse: [self objectClass: rcvr].
- meth := class lookupSelector: selector.
- meth == nil ifTrue:
- [^self
- send: #doesNotUnderstand:
- to: rcvr
- with: (Array with: (Message selector: selector arguments: args))
- super: superFlag].
- val := self tryPrimitiveFor: meth receiver: rcvr args: args.
- ((self objectClass: val) == Array
- and: [val size = 2
- and: [val first == PrimitiveFailToken]]) ifFalse:
- [^val].
- (selector == #doesNotUnderstand:
- and: [class == ProtoObject]) ifTrue:
- [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood'].
- ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class.
- ((self objectClass: val) == Array
- and: [val size = 2
- and: [val first == PrimitiveFailToken
- and: [val last notNil
- and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue:
- [ctxt at: ctxt stackPtr put: val last].
- ^ctxt!
Item was changed:
----- Method: ContextPart>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') -----
tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
+ "Invoke the named primitive for aCompiledMethod, answering its result, or,
+ if the primiitve fails, answering the error code."
- | selector theMethod spec receiverClass |
<primitive: 218 error: ec>
ec ifNotNil:
["If ec is an integer other than -1 there was a problem with primitive 218,
not with the external primitive itself. -1 indicates a generic failure (where
ec should be nil) but ec = nil means primitive 218 is not implemented. So
interpret -1 to mean the external primitive failed with a nil error code."
ec isInteger ifTrue:
[ec = -1
ifTrue: [ec := nil]
+ ifFalse: [self primitiveFailed]]].
+ ^self class primitiveFailTokenFor: ec!
- ifFalse: [self primitiveFailed]].
- ^{PrimitiveFailToken. ec}].
- "Assume a nil error code implies the primitive is not implemented and fall back on the old code."
- "Hack. Attempt to execute the named primitive from the given compiled method"
- arguments size > 8 ifTrue:
- [^{PrimitiveFailToken. nil}].
- selector := #(
- tryNamedPrimitive
- tryNamedPrimitive:
- tryNamedPrimitive:with:
- tryNamedPrimitive:with:with:
- tryNamedPrimitive:with:with:with:
- tryNamedPrimitive:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:with:with:) at: arguments size+1.
- receiverClass := self objectClass: aReceiver.
- theMethod := receiverClass lookupSelector: selector.
- theMethod == nil ifTrue:
- [^{PrimitiveFailToken. nil}].
- spec := theMethod literalAt: 1.
- spec replaceFrom: 1 to: spec size with: (aCompiledMethod literalAt: 1) startingAt: 1.
- Smalltalk unbindExternalPrimitives.
- ^self object: aReceiver perform: selector withArguments: arguments inClass: receiverClass!
Item was added:
+ ----- Method: InstructionClient>>callPrimitive: (in category 'instruction decoding') -----
+ callPrimitive: pimIndex
+ "V3PlusClosures: 139 10001011 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ NewsqueakV4: 249 11111001 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + ( jjjjjjj * 256)
+ m=1 means inlined primitive, no hard return after execution."!
Item was added:
+ ----- Method: InstructionPrinter>>callPrimitive: (in category 'instruction decoding') -----
+ callPrimitive: index
+ "Print the callPrimitive."
+
+ self print: 'callPrimtive: ' , index printString!
Item was changed:
----- Method: InstructionStream>>interpretV3ClosuresExtension:in:for: (in category 'decoding - private - v3 plus closures') -----
interpretV3ClosuresExtension: offset in: method for: client
| type offset2 byte2 byte3 byte4 |
offset <= 6 ifTrue:
["Extended op codes 128-134"
byte2 := method at: pc. pc := pc + 1.
offset <= 2 ifTrue:
["128-130: extended pushes and pops"
type := byte2 // 64.
offset2 := byte2 \\ 64.
offset = 0 ifTrue:
[type = 0 ifTrue: [^client pushReceiverVariable: offset2].
type = 1 ifTrue: [^client pushTemporaryVariable: offset2].
type = 2 ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)].
type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]].
offset = 1 ifTrue:
[type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2].
type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2].
type = 2 ifTrue: [self error: 'illegalStore'].
type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
offset = 2 ifTrue:
[type = 0 ifTrue: [^client popIntoReceiverVariable: offset2].
type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2].
type = 2 ifTrue: [self error: 'illegalStore'].
type = 3 ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
"131-134: extended sends"
offset = 3 ifTrue: "Single extended send"
[^client send: (method literalAt: byte2 \\ 32 + 1)
super: false numArgs: byte2 // 32].
offset = 4 ifTrue: "Double extended do-anything"
[byte3 := method at: pc. pc := pc + 1.
type := byte2 // 32.
type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1)
super: false numArgs: byte2 \\ 32].
type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1)
super: true numArgs: byte2 \\ 32].
type = 2 ifTrue: [^client pushReceiverVariable: byte3].
type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)].
type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)].
type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3].
type = 6 ifTrue: [^client popIntoReceiverVariable: byte3].
type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
offset = 5 ifTrue: "Single extended send to super"
[^client send: (method literalAt: byte2 \\ 32 + 1)
super: true
numArgs: byte2 // 32].
offset = 6 ifTrue: "Second extended send"
[^client send: (method literalAt: byte2 \\ 64 + 1)
super: false
numArgs: byte2 // 64]].
offset = 7 ifTrue: [^client doPop].
offset = 8 ifTrue: [^client doDup].
offset = 9 ifTrue: [^client pushActiveContext].
byte2 := method at: pc. pc := pc + 1.
offset = 10 ifTrue:
[^byte2 < 128
ifTrue: [client pushNewArrayOfSize: byte2]
ifFalse: [client pushConsArrayWithElements: byte2 - 128]].
- offset = 11 ifTrue: [^self error: 'unusedBytecode'].
byte3 := method at: pc. pc := pc + 1.
+ offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)].
offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3].
offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
"offset = 15"
byte4 := method at: pc. pc := pc + 1.
^client
pushClosureCopyNumCopiedValues: (byte2 bitShift: -4)
numArgs: (byte2 bitAnd: 16rF)
blockSize: (byte3 * 256) + byte4!
Item was changed:
----- Method: Integer class>>initialize (in category 'class initialization') -----
+ initialize
+ "Integer initialize"
+ self initializeLowBitPerByteTable!
- initialize "Integer initialize"
- "Ensure we have the right compact class index"
-
- "LPI has been a compact class forever - just ensure basic correctness"
- (LargePositiveInteger indexIfCompact = 5) ifFalse:[
- (Smalltalk compactClassesArray at: 5)
- ifNil:[LargePositiveInteger becomeCompactSimplyAt: 5]
- ifNotNil:[self error: 'Unexpected compact class setup']].
-
- "Cog requires LNI to be compact at 4 (replacing PseudoContext)"
- (LargeNegativeInteger indexIfCompact = 4) ifFalse:[
- "PseudoContext will likely get removed at some point so write this test
- without introducing a hard dependency"
- (Smalltalk compactClassesArray at: 4) name == #PseudoContext
- ifTrue:[Smalltalk compactClassesArray at: 4 put: nil].
- (Smalltalk compactClassesArray at: 4)
- ifNil:[LargeNegativeInteger becomeCompactSimplyAt: 4]
- ifNotNil:[self error: 'Unexpected compact class setup']].
-
- self initializeLowBitPerByteTable
- !
Item was added:
+ ----- Method: MethodContext class>>allInstances (in category 'enumerating') -----
+ allInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since this context has been created only to
+ compute the existing instances."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ insts nextPut: inst.
+ inst := next].
+ ^insts contents!
Item was changed:
----- Method: MethodContext class>>allInstancesDo: (in category 'private') -----
allInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since evaluation of aBlock will create new contexts."
- "Only count until thisContext since evaluation of aBlock will create new contexts."
- | inst next |
inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
- [inst == thisContext] whileFalse:[
- next := inst nextInstance.
- aBlock value: inst.
- inst := next]
- !
Item was added:
+ ----- Method: MethodContext>>failPrimitiveWith: (in category 'system simulation') -----
+ failPrimitiveWith: maybePrimFailToken
+ "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive:
+ bytecode and store the primitive fail code if there is one and the method consumes it."
+ self skipCallPrimitive.
+ ((self isPrimFailToken: maybePrimFailToken)
+ and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
+ [self at: stackp put: maybePrimFailToken last]!
Item was changed:
----- Method: ProtoObject>>scaledIdentityHash (in category 'comparing') -----
scaledIdentityHash
"For identityHash values returned by primitive 75, answer
+ such values times 2^8. Otherwise, match the existing
+ identityHash implementation"
- such values times 2^18. Otherwise, match the existing
- identityHash implementation"
+ ^self identityHash * 256 "bitShift: 8"!
- ^self identityHash * 262144 "bitShift: 18"!
Item was changed:
==== ERROR ===
Error: Unrecognized class type
27 September 2014 8:29:49.152 pm
VM: unix - a SmalltalkImage
Image: Squeak3.11alpha [latest update: #8824]
SecurityManager state:
Restricted: false
FileAccess: true
SocketAccess: true
Working Dir /home/squeaksource
Trusted Dir /home/squeaksource/secure
Untrusted Dir /home/squeaksource/My Squeak
MCClassDefinition(Object)>>error:
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
aString: 'Unrecognized class type'
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
MCClassDefinition>>kindOfSubclass
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
MCClassDefinition>>printDefinitionOn:
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
stream: a WriteStream
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
[] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
Receiver: a MCDiffyTextWriter
Arguments and temporary variables:
definition: a WriteStream
s: a MCClassDefinition(SmallInteger)
Receiver's instance variables:
stream: a WriteStream
initStream: nil
--- The full stack ---
MCClassDefinition(Object)>>error:
MCClassDefinition>>kindOfSubclass
MCClassDefinition>>printDefinitionOn:
[] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
String class(SequenceableCollection class)>>new:streamContents:
String class(SequenceableCollection class)>>streamContents:
MCDiffyTextWriter(MCTextWriter)>>chunkContents:
MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
MCDiffyTextWriter(MCStWriter)>>visitClassDefinition:
MCClassDefinition>>accept:
[] in MCDiffyTextWriter(MCTextWriter)>>visitInFork:
String class(SequenceableCollection class)>>new:streamContents:
String class(SequenceableCollection class)>>streamContents:
MCDiffyTextWriter(MCTextWriter)>>visitInFork:
MCDiffyTextWriter>>writePatchFrom:to:
MCDiffyTextWriter>>writeModification:
[] in MCDiffyTextWriter>>writePatch:
SortedCollection(OrderedCollection)>>do:
MCDiffyTextWriter>>writePatch:
SSDiffyTextWriter>>writePatch:
[] in SSDiffyTextWriter>>writeVersion:for:
BlockClosure>>on:do:
SSDiffyTextWriter>>writeVersion:for:
[] in SSEMailSubscription>>versionAdded:to:
BlockClosure>>on:do:
SSEMailSubscription>>versionAdded:to:
[] in [] in SSProject>>versionAdded:
[] in BlockClosure>>newProcess
1
0
Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel.spur-ul.875.mcz
==================== Summary ====================
Name: Kernel.spur-ul.875
Author: eem
Time: 27 September 2014, 1:16:59.187 pm
UUID: 3e4a6002-9948-4f78-a687-78b70614ac74
Ancestors: Kernel-ul.875
Kernel-ul.875 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.208
- improved Date >> #printFormat:
- added #isZero to LargeIntegers
=============== Diff against Kernel-ul.875 ===============
Item was changed:
----- Method: Behavior>>allInstances (in category 'accessing instances and variables') -----
+ allInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == nil] whileFalse:
+ [next := inst nextInstance.
+ (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
+ inst := next].
+ ^insts contents!
- allInstances
- "Answer a collection of all current instances of the receiver."
-
- | all |
- all := OrderedCollection new.
- self allInstancesDo: [:x | x == all ifFalse: [all add: x]].
- ^ all asArray
- !
Item was changed:
----- Method: Behavior>>allInstancesDo: (in category 'enumerating') -----
+ allInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst."
- allInstancesDo: aBlock
- "Evaluate the argument, aBlock, for each of the current instances of the
- receiver.
-
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst."
- | inst next |
inst := self someInstance.
+ [inst == nil] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
- [inst == nil]
- whileFalse:
- [
- next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was added:
+ ----- Method: Behavior>>allInstancesOrNil (in category 'enumerating') -----
+ allInstancesOrNil
+ "Answer all instances of the receiver, or nil if the primitive
+ fails, which it may be due to being out of memory."
+ <primitive: 177>
+ ^nil!
Item was changed:
----- Method: Behavior>>basicNew (in category 'instance creation') -----
basicNew
"Primitive. Answer an instance of the receiver (which is a class) with no
+ indexable variables. Fail if the class is indexable. Essential. See Object
+ documentation whatIsAPrimitive.
+
+ If the primitive fails because space is low then the scavenger will run
+ before the method is activated. Check that space was low and retry
+ via handleFailingBasicNew if so."
- indexable variables. Fail if the class is indexable. Essential. See Object
- documentation whatIsAPrimitive."
+ <primitive: 70 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingBasicNew].
+ self isVariable ifTrue: [^self basicNew: 0].
+ self primitiveFailed!
- <primitive: 70>
- self isVariable ifTrue: [ ^ self basicNew: 0 ].
- "space must be low"
- OutOfMemory signal.
- ^ self basicNew "retry if user proceeds"
- !
Item was changed:
----- Method: Behavior>>basicNew: (in category 'instance creation') -----
+ basicNew: sizeRequested
+ "Primitive. Answer an instance of this class with the number of indexable
+ variables specified by the argument, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive.
+
+ If the primitive fails because space is low then the scavenger will run before the
+ method is activated. Check args and retry via handleFailingBasicNew: if they're OK."
- basicNew: sizeRequested
- "Primitive. Answer an instance of this class with the number
- of indexable variables specified by the argument, sizeRequested.
- Fail if this class is not indexable or if the argument is not a
- positive Integer, or if there is not enough memory available.
- Essential. See Object documentation whatIsAPrimitive."
+ <primitive: 71 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingBasicNew: sizeRequested].
- <primitive: 71>
self isVariable ifFalse:
[self error: self printString, ' cannot have variable sized instances'].
- (sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue:
- ["arg okay; space must be low."
- OutOfMemory signal.
- ^ self basicNew: sizeRequested "retry if user proceeds"].
self primitiveFailed!
Item was added:
+ ----- Method: Behavior>>byteSizeOfInstance (in category 'accessing instances and variables') -----
+ byteSizeOfInstance
+ "Answer the total memory size of an instance of the receiver."
+
+ <primitive: 181 error: ec>
+ self isVariable ifTrue:
+ [^self byteSizeOfInstanceOfSize: 0].
+ self primitiveFailed!
Item was added:
+ ----- Method: Behavior>>byteSizeOfInstanceOfSize: (in category 'accessing instances and variables') -----
+ byteSizeOfInstanceOfSize: basicSize
+ "Answer the total memory size of an instance of the receiver
+ with the given number of indexable instance variables."
+
+ <primitive: 181 error: ec>
+ self isVariable
+ ifTrue: "If the primitive overflowed answer a close approximation"
+ [(basicSize isInteger
+ and: [basicSize >= 16r1000000]) ifTrue:
+ [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
+ - (self byteSizeOfInstanceOfSize: 0)]]
+ ifFalse:
+ [basicSize = 0 ifTrue:
+ [^self byteSizeOfInstance]].
+ self primitiveFailed!
Item was added:
+ ----- 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 (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 added:
+ ----- Method: Behavior>>handleFailingBasicNew (in category 'private') -----
+ handleFailingBasicNew
+ "handleFailingBasicNew gets sent after basicNew 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 70>
+ Smalltalk garbageCollect < 1048576 ifTrue:
+ [Smalltalk growMemoryByAtLeast: 1048576].
+ ^self handleFailingFailingBasicNew "retry after global garbage collect"!
Item was added:
+ ----- Method: Behavior>>handleFailingBasicNew: (in category 'private') -----
+ handleFailingBasicNew: sizeRequested
+ "handleFailingBasicNew: gets sent after basicNew: 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 71>
+ | bytesRequested |
+ bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
+ Smalltalk garbageCollect < bytesRequested ifTrue:
+ [Smalltalk growMemoryByAtLeast: bytesRequested].
+ "retry after global garbage collect and possible grow"
+ ^self handleFailingFailingBasicNew: sizeRequested!
Item was added:
+ ----- Method: Behavior>>handleFailingFailingBasicNew (in category 'private') -----
+ handleFailingFailingBasicNew
+ "This basicNew 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 70>
+ "space must be low"
+ OutOfMemory signal.
+ ^self basicNew "retry if user proceeds"!
Item was added:
+ ----- Method: Behavior>>handleFailingFailingBasicNew: (in category 'private') -----
+ handleFailingFailingBasicNew: sizeRequested
+ "This basicNew: 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 71>
+ "space must be low."
+ OutOfMemory signal.
+ ^self basicNew: sizeRequested "retry if user proceeds"!
Item was added:
+ ----- Method: Behavior>>identityHash (in category 'comparing') -----
+ identityHash
+ "Answer a SmallInteger whose value is related to the receiver's identity.
+ Behavior implements identityHash to allow the VM to use an object representation which
+ does not include a direct reference to an object's class in an object. If the VM is using
+ this implementation then classes are held in a class table and instances contain the index
+ of their class in the table. A class's class table index is its identityHash so that an instance
+ can be created without searching the table for a class's index. The VM uses this primitive
+ to enter the class into the class table, assigning its identityHash with an as yet unused
+ class table index. If this primitive fails it means that the class table is full. In Spur as of
+ 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
+
+ Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
+
+ <primitive: 175>
+ self primitiveFailed!
Item was changed:
----- Method: Behavior>>indexIfCompact (in category 'private') -----
indexIfCompact
+ "Backward compatibility with the Squeak V3 object format.
+ Spur does not have a distinction between compact and non-compact classes."
+ ^0!
- "If these 5 bits are non-zero, then instances of this class
- will be compact. It is crucial that there be an entry in
- Smalltalk compactClassesArray for any class so optimized.
- See the msgs becomeCompact and becomeUncompact."
- ^ (format bitShift: -11) bitAnd: 16r1F
- "
- Smalltalk compactClassesArray doWithIndex:
- [:c :i | c == nil ifFalse:
- [c indexIfCompact = i ifFalse: [self halt]]]
- "!
Item was changed:
----- Method: Behavior>>instSize (in category 'testing') -----
instSize
"Answer the number of named instance variables
+ (as opposed to indexed variables) of the receiver.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>"
+ ^format bitAnd: 16rFFFF!
- (as opposed to indexed variables) of the receiver."
-
- self flag: #instSizeChange. "Smalltalk browseAllCallsOn: #instSizeChange"
- "
- NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
- When we revise the image format, it should become...
- ^ ((format bitShift: -1) bitAnd: 16rFF) - 1
- Note also that every other method in this category will require
- 2 bits more of right shift after the change.
- "
- ^ ((format bitShift: -10) bitAnd: 16rC0) + ((format bitShift: -1) bitAnd: 16r3F) - 1!
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 (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)"
+ ^(format bitShift: -16) bitAnd: 16r1F!
- ^ (format bitShift: -7) bitAnd: 16rF!
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 (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!
- "Answer whether the receiver contains just bits (not pointers)."
-
- ^ self instSpec >= 6!
Item was changed:
----- Method: Behavior>>isBytes (in category 'testing') -----
isBytes
+ "Answer whether the receiver has 8-bit 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 (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!
- "Answer whether the receiver has 8-bit instance variables."
-
- ^ self instSpec >= 8!
Item was added:
+ ----- Method: Behavior>>isEphemeronClass (in category 'testing') -----
+ isEphemeronClass
+ "Answer whether the receiver has ephemeral instance variables. The garbage collector will
+ fire (queue for finalization) any ephemeron whose first instance variable is not referenced
+ other than from the transitive closure of references from ephemerons. Hence referring to
+ an object from the first inst var of an ephemeron will cause the ephemeron to fire when
+ the rest of the system does not refer to the object and that object is ready to be collected.
+ Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
+ from firing, ephemerons may act as the associations in weak dictionaries such that the value
+ (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
+ other than from ephemerons. Ephemerons can therefore be used to implement instance-based
+ pre-mortem finalization."
+ ^self instSpec = 5!
Item was added:
+ ----- Method: Behavior>>isImmediateClass (in category 'testing') -----
+ isImmediateClass
+ "Answer whether the receiver has immediate instances. Immediate instances
+ store their value in their object pointer, not in an object body. Hence immediates
+ take no space and are immutable. The immediates are distinguished by tag bits
+ in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit
+ system SmallIntegers are 31-bit signed integers and Characters are 30-bit
+ unsigned character codes."
+ ^self instSpec = 7!
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 (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]]!
- "Answer whether the receiver has indexable variables."
-
- ^ self instSpec >= 2!
Item was changed:
----- Method: Behavior>>kindOfSubclass (in category 'testing class hierarchy') -----
kindOfSubclass
+ "Answer a String that is the keyword that describes the receiver's kind of subclass,
+ either a regular subclass, a variableSubclass, a variableByteSubclass,
+ a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
+ c.f. typeOfClass"
+ ^self isVariable
+ ifTrue:
+ [self isBits
+ ifTrue:
+ [self isBytes
+ ifTrue: [' variableByteSubclass: ']
+ ifFalse: [' variableWordSubclass: ']]
+ ifFalse:
+ [self isWeak
+ ifTrue: [' weakSubclass: ']
+ ifFalse: [' variableSubclass: ']]]
+ ifFalse:
+ [self isImmediateClass
+ ifTrue: [' immediateSubclass: ']
+ ifFalse:
+ [self isEphemeronClass
+ ifTrue: [' ephemeronSubclass: ']
+ ifFalse: [' subclass: ']]]!
- "Answer a String that is the keyword that describes the receiver's kind
- of subclass, either a regular subclass, a variableSubclass, a
- variableByteSubclass, a variableWordSubclass, or a weakSubclass."
- self isWeak
- ifTrue: [^ ' weakSubclass: '].
- ^ self isVariable
- ifTrue: [self isBits
- ifTrue: [self isBytes
- ifTrue: [ ' variableByteSubclass: ']
- ifFalse: [ ' variableWordSubclass: ']]
- ifFalse: [ ' variableSubclass: ']]
- ifFalse: [ ' subclass: ']!
Item was changed:
----- Method: Behavior>>shouldNotBeRedefined (in category 'testing') -----
shouldNotBeRedefined
+ "Answer if the receiver should not be redefined.
+ The assumption is that classes in Smalltalk specialObjects and
+ instance-specific Behaviors should not be redefined"
- "Return true if the receiver should not be redefined.
- The assumption is that compact classes,
- classes in Smalltalk specialObjects and
- Behaviors should not be redefined"
+ ^(Smalltalk specialObjectsArray
+ identityIndexOf: self
+ ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!
- ^(Smalltalk compactClassesArray includes: self)
- or:[(Smalltalk specialObjectsArray includes: self)
- or:[self isKindOf: self]]!
Item was changed:
----- Method: Behavior>>typeOfClass (in category 'accessing') -----
typeOfClass
+ "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass"
+ self isBytes ifTrue:
+ [^self instSpec = CompiledMethod instSpec
+ ifTrue: [#compiledMethod] "Very special!!"
+ ifFalse: [#bytes]].
+ (self isWords and: [self isPointers not]) ifTrue:
+ [^self instSpec = SmallInteger instSpec
+ ifTrue: [#immediate] "Very special!!"
+ ifFalse: [#words]].
+ self isWeak ifTrue: [^#weak].
+ self isVariable ifTrue: [^#variable].
+ self isEphemeronClass ifTrue: [^#ephemeron].
+ ^#normal!
- "Answer a symbol uniquely describing the type of the receiver"
- self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!"
- self isBytes ifTrue:[^#bytes].
- (self isWords and:[self isPointers not]) ifTrue:[^#words].
- self isWeak ifTrue:[^#weak].
- self isVariable ifTrue:[^#variable].
- ^#normal.!
Item was changed:
----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') -----
simulateValueWithArguments: anArray caller: aContext
+ "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
| newContext sz |
- (anArray class ~~ Array
- or: [numArgs ~= anArray size]) ifTrue:
- [^ContextPart primitiveFailTokenFor: nil].
newContext := (MethodContext newForMethod: outerContext method)
setSender: aContext
receiver: outerContext receiver
method: outerContext method
closure: self
startpc: startpc.
+ ((newContext objectClass: anArray) ~~ Array
+ or: [numArgs ~= anArray size]) ifTrue:
+ [^ContextPart primitiveFailTokenFor: nil].
sz := self basicSize.
newContext stackp: sz + numArgs.
1 to: numArgs do:
[:i| newContext at: i put: (anArray at: i)].
1 to: sz do:
[:i| newContext at: i + numArgs put: (self at: i)].
^newContext!
Item was added:
+ ----- Method: Class>>immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
+ immediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new
+ immediate class as a subclass of an existing class (the receiver)."
+ ^ClassBuilder new
+ superclass: self
+ immediateSubclass: t
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was changed:
----- Method: ClassBuilder>>computeFormat:instSize:forSuper:ccIndex: (in category 'class format') -----
computeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
"Compute the new format for making oldClass a subclass of newSuper.
+ Answer the format or nil if there is any problem."
- Return the format or nil if there is any problem."
| instSize isVar isWords isPointers isWeak |
type == #compiledMethod ifTrue:
+ [newInstSize > 0 ifTrue:
+ [self error: 'A compiled method class cannot have named instance variables'.
+ ^nil].
+ ^CompiledMethod format].
- [^(CompiledMethod format
- bitClear: (16r1F bitShift: 11))
- bitOr: (ccIndex bitShift: 11)].
instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
+ instSize > 65535 ifTrue:
- instSize > 254 ifTrue:
[self error: 'Class has too many instance variables (', instSize printString,')'.
^nil].
type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
+ type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
+ type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
+ (isPointers not and: [instSize > 0]) ifTrue:
+ [self error: 'A non-pointer class cannot have named instance variables'.
- (isPointers not and:[instSize > 0]) ifTrue:
- [self error:'A non-pointer class cannot have instance variables'.
^nil].
+ ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
- ^(self format: instSize
- variable: isVar
- words: isWords
- pointers: isPointers
- weak: isWeak) + (ccIndex bitShift: 11).!
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 (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 |
- format: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
- "Compute the format for the given instance specfication."
- | cClass instSpec sizeHiBits fmt |
- self flag: #instSizeChange.
- "
- Smalltalk browseAllCallsOn: #instSizeChange.
- Smalltalk browseAllImplementorsOf: #fixedFieldsOf:.
- Smalltalk browseAllImplementorsOf: #instantiateClass:indexableSize:.
- "
- "
- NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
- For now the format word is...
- <2 bits=instSize//64><5 bits=cClass><4 bits=instSpec><6 bits=instSize\\64><1 bit=0>
- But when we revise the image format, it should become...
- <5 bits=cClass><4 bits=instSpec><8 bits=instSize><1 bit=0>
- "
- sizeHiBits := (nInstVars+1) // 64.
- cClass := 0. "for now"
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!
- ifTrue:[4]
- ifFalse:[isPointers
- ifTrue: [isVar
- ifTrue: [nInstVars>0 ifTrue: [3] ifFalse: [2]]
- ifFalse: [nInstVars>0 ifTrue: [1] ifFalse: [0]]]
- ifFalse: [isWords ifTrue: [6] ifFalse: [8]]].
- fmt := sizeHiBits.
- fmt := (fmt bitShift: 5) + cClass.
- fmt := (fmt bitShift: 4) + instSpec.
- fmt := (fmt bitShift: 6) + ((nInstVars+1)\\64). "+1 since prim size field includes header"
- fmt := (fmt bitShift: 1). "This shift plus integer bit lets wordSize work like byteSize"
- ^fmt!
Item was added:
+ ----- Method: ClassBuilder>>superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
+ superclass: aClass
+ immediateSubclass: t instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a
+ new immediate class as a subclass of an existing class."
+ | env |
+ aClass instSize > 0
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
+ aClass isVariable
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
+ aClass isPointers
+ ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
+ "Cope with pre-environment and environment versions. Simplify asap."
+ env := (Smalltalk classNamed: #EnvironmentRequest)
+ ifNil: [aClass environment]
+ ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
+ ^self
+ name: t
+ inEnvironment: env
+ subclassOf: aClass
+ type: #immediate
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was changed:
----- Method: ClassBuilder>>update:to: (in category 'class mutation') -----
update: oldClass to: newClass
+ "Convert oldClass, all its instances and possibly its meta class into newClass,
+ instances of newClass and possibly its meta class. The process is surprisingly
+ simple in its implementation and surprisingly complex in its nuances and potentially
+ bad side effects.
+ We can rely on two assumptions (which are critical):
+ #1: The method #updateInstancesFrom: will not create any lasting pointers to
+ 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
+ a become of the old vs. the new instances and therefore it will not create
+ pointers to *new* instances before the #become: which are *old* afterwards)
+ #2: The non-preemptive execution of the critical piece of code guarantees that
+ nobody can get a hold by 'other means' (such as process interruption and
+ reflection) on the old instances.
+ Given the above two, we know that after #updateInstancesFrom: there are no pointers
+ to any old instances. After the forwarding become there will be no pointers to the old
+ class or meta class either.
+ Andreas Raab, 2/27/2003 23:42"
- "Convert oldClass, all its instances and possibly its meta class into newClass, instances of newClass and possibly its meta class. The process is surprisingly simple in its implementation and surprisingly complex in its nuances and potentially bad side effects.
- We can rely on two assumptions (which are critical):
- #1: The method #updateInstancesFrom: will not create any lasting pointers to 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do a become of the old vs. the new instances and therefore it will not create pointers to *new* instances before the #become: which are *old* afterwards)
- #2: The non-preemptive execution of the critical piece of code guarantees that nobody can get a hold by 'other means' (such as process interruption and reflection) on the old instances.
- Given the above two, we know that after #updateInstancesFrom: there are no pointer to any old instances. After the forwarding become there will be no pointers to the old class or meta class either. Meaning that if we throw in a nice fat GC at the end of the critical block, everything will be gone (but see the comment right there). There's no need to worry.
- "
| meta |
meta := oldClass isMeta.
"Note: Everything from here on will run without the ability to get interrupted
to prevent any other process to create new instances of the old class."
+ ["Note: The following removal may look somewhat obscure and needs an explanation.
+ When we mutate the class hierarchy we create new classes for any existing subclass.
+ So it may look as if we don't have to remove the old class from its superclass. However,
+ at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
+ created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
+ subclasses. Since the #become: below will transparently replace the pointers to oldClass
+ with newClass the superclass would have newClass in its subclasses TWICE. With rather
+ unclear effects if we consider that we may convert the meta-class hierarchy itself (which
+ is derived from the non-meta class hierarchy).
+ Due to this problem ALL classes are removed from their superclass just prior to converting
+ them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
+ effectively remove the oldClass (becomeForward:) just a few lines below."
- [
- "Note: The following removal may look somewhat obscure and needs an explanation. When we mutate the class hierarchy we create new classes for any existing subclass. So it may look as if we don't have to remove the old class from its superclass. However, at the top of the hierarchy (the first class we reshape) that superclass itself is not newly created so therefore it will hold both the oldClass and newClass in its (obsolete or not) subclasses. Since the #become: below will transparently replace the pointers to oldClass with newClass the superclass would have newClass in its subclasses TWICE. With rather unclear effects if we consider that we may convert the meta-class hierarchy itself (which is derived from the non-meta class hierarchy).
- Due to this problem ALL classes are removed from their superclass just prior to converting them. Here, breaking the superclass/subclass invariant really doesn't matter since we will effectively remove the oldClass (become+GC) just a few lines below."
oldClass superclass removeSubclass: oldClass.
oldClass superclass removeObsoleteSubclass: oldClass.
"make sure that the VM cache is clean"
oldClass methodDict do: [:cm | cm flushCache].
"Convert the instances of oldClass into instances of newClass"
newClass updateInstancesFrom: oldClass.
meta
ifTrue:
[oldClass becomeForward: newClass.
oldClass updateMethodBindingsTo: oldClass binding]
ifFalse:
[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
oldClass updateMethodBindingsTo: oldClass binding.
oldClass class updateMethodBindingsTo: oldClass class binding].
+ "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
+ to ensure no old instances existed after the becomeForward:. Without the GC it was possible
+ to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
+ updated references from the old objects to new objects but didn't destroy the old objects.
+ But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
+ valueUnpreemptively!
- Smalltalk garbageCollect.
-
- "Warning: Read this before you even think about removing the GC. Yes, it slows us down. Quite heavily if you have a large image. However, there's no good and simple alternative here, since unfortunately, #become: does change class pointers. What happens is that after the above become all of the instances of the old class will have a class pointer identifying them as instances of newClass. If we get our hands on any of these instances we will break immediately since their expected instance layout (that of its class, e.g., newClass) will not match their actual instance layout (that of oldClass). And getting your hands on any of those instances is really simple - just reshaping one class two times in rapid succession will do it. Reflection techniques, interrupts, etc. will only add to this problem. In the case of Metaclass things get even worse since when we recompile the entire class hierarchy we will recompile both, Metaclass and its instances (and some of its instances will have the old and some the new layout).
-
- The only easy solution to this problem would be to 'fix up' the class pointers of the old instances to point to the old class (using primitiveChangeClassTo:). But this won't work either - as we do a one-way become we would have to search the entire object memory for the oldClass and couldn't even clearly identify it unless we give it some 'special token' which sounds quite error-prone. If you really need to get rid of the GC here are some alternatives:
-
- On the image level, one could create a copy of the oldClass before becoming it into the new class and, after becoming it, 'fix up' the old instances. That would certainly work but it sounds quite complex, as we need to make sure we're not breaking any of the superclass/subclass meta/non-meta class variants.
-
- Alternatively, fix up #becomeForward on the VM-level to 'dump the source objects' of #become. This would be quite doable (just 'convert' them into a well known special class such as bitmap) yet it has problems if (accidentally or not) one of the objects in #become: appears on 'both sides of the fence' (right now, this will work ... in a way ... even though the consequences are unclear).
-
- Another alternative is to provide a dedicated primitive for this (instead of using it implicitly in become) which would allow us to dump all the existing instances right here. This is equivalent to a more general primitiveChangeClassTo: and might be worthwhile but it would likely have to keep in mind the differences between bits and pointer thingies etc.
-
- Since all of the alternatives seem rather complex and magical compared to a straight-forward GC it seems best to stick with the GC solution for now. If someone has a real need to fix this problem, that person will likely be motivated enough to check out the alternatives. Personally I'd probably go for #1 (copy the old class and remap the instances to it) since it's a solution that could be easily reverted from within the image if there's any problem with it."
-
- ] valueUnpreemptively.
- !
Item was changed:
ByteArray variableByteSubclass: #CompiledMethod
instanceVariableNames: ''
classVariableNames: 'LargeFrame PrimaryBytecodeSetEncoderClass SecondaryBytecodeSetEncoderClass SmallFrame'
poolDictionaries: ''
category: 'Kernel-Methods'!
+ !CompiledMethod commentStamp: 'eem 8/12/2014 14:45' prior: 0!
+ CompiledMethod instances are methods suitable for interpretation by the virtual machine. Instances of CompiledMethod and its subclasses are the only objects in the system that have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. CompiledMethod inherits from ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray.
- !CompiledMethod commentStamp: 'eem 5/12/2014 18:02' prior: 0!
- My instances are methods suitable for interpretation by the virtual machine. This is the only class in the system whose instances have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. I'm a subclass of ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray.
Class variables:
SmallFrame - the number of stack slots in a small frame Context
LargeFrame - the number of stack slots in a large frame Context
PrimaryBytecodeSetEncoderClass - the encoder class that defines the primary instruction set
SecondaryBytecodeSetEncoderClass - the encoder class that defines the secondary instruction set
The current format of a CompiledMethod is as follows:
header (4 or 8 bytes, SmallInteger)
+ literals (4 or 8 bytes each, Object, see "The last literal..." below)
- literals (4 or 8 bytes each, Object)
bytecodes (variable, bytes)
trailer (variable, bytes)
+ The header is a 31-bit signed integer (a SmallInteger) in the following format:
- The header is a 31-bit signed integer (a SmallInteger) with one of the two following formats, selected by the sign bit:
- sign bit 0, header >= 0:
- (index 0) 9 bits: main part of primitive number (#primitive)
- (index 9) 8 bits: number of literals (#numLiterals)
- (index 17) 1 bit: whether a large frame size is needed (#frameSize)
- (index 18) 6 bits: number of temporary variables (#numTemps)
- (index 24) 4 bits: number of arguments to the method (#numArgs)
- (index 28) 1 bit: high-bit of primitive number (#primitive)
- (index 29) 1 bit: flag bit, ignored by the VM (#flag)
- (index 30/63) sign bit: 0 selects the Primary instruction set (#signFlag)
- sign bit 1, header < 0:
(index 0) 16 bits: number of literals (#numLiterals)
(index 16) 1 bit: has primitive
+ (index 17) 1 bit: whether a large frame size is needed (#frameSize => either SmallFrame or LargeFrame)
- (index 17) 1 bit: whether a large frame size is needed (#frameSize)
(index 18) 6 bits: number of temporary variables (#numTemps)
(index 24) 4 bits: number of arguments to the method (#numArgs)
+ (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public), although accessors for bit 29 exist (see #flag).
+ (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4, 0 selects the primary instruction set, e.g. SqueakV3PlusClosures) (#signFlag)
- (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public)
- (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4) (#signFlag)
- i.e. the Secondary Bytecode Set expands the number of literals to 65535 by assuming a CallPrimitive bytecode.
+ If the method has a primitive then the first bytecode of the method must be a callPrimitive: bytecode that encodes the primitive index.
+
+ The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.
+
+ The last literal in a CompiledMethod must be its methodClassAssociation, a binding whose value is the class the method is installed in. The methodClassAssociation is used to implement super sends. If a method contains no super send then its methodClassAssociation may be left nil (as would be the case for example of methods providing a pool of inst var accessors). By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState. AdditionalMethodState holds any pragmas and properties of a method, but may also be used to add instance variables to a method, albeit ones held in the method's AdditionalMethodState. Subclasses of CompiledMethod that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledMethod subclass to answer the specialized subclass of AdditionalMethodState.!
- The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.!
Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 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."
+ | method pc |
+ nArgs > 15 ifTrue:
+ [^self error: 'Cannot compile -- too many arguments'].
- | largeBit primBits |
nTemps > 63 ifTrue:
+ [^self error: 'Cannot compile -- too many temporary variables'].
+ nLits > 65535 ifTrue:
+ [^self error: 'Cannot compile -- too many literals'].
- [^ self error: 'Cannot compile -- too many temporary variables'].
- nLits > 255 ifTrue:
- [^ self error: 'Cannot compile -- too many literals'].
- 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)].
+ 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!
- ^trailer
- createMethod: numberOfBytes
- class: self
- header: (nArgs bitShift: 24) +
- (nTemps bitShift: 18) +
- (largeBit bitShift: 17) +
- (nLits bitShift: 9) +
- 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."
+ | method pc |
+ nArgs > 15 ifTrue:
+ [^self error: 'Cannot compile -- too many arguments'].
- | largeBit primBits flagBit |
nTemps > 63 ifTrue:
+ [^self error: 'Cannot compile -- too many temporary variables'].
+ nLits > 65535 ifTrue:
+ [^self error: 'Cannot compile -- too many literals'].
- [^ self error: 'Cannot compile -- too many temporary variables'].
- nLits > 255 ifTrue:
- [^ self error: 'Cannot compile -- too many literals'].
- largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0].
+ 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!
- "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 ].
-
- ^trailer
- createMethod: numberOfBytes
- class: self
- header: (nArgs bitShift: 24) +
- (nTemps bitShift: 18) +
- (largeBit bitShift: 17) +
- (nLits bitShift: 9) +
- primBits +
- (flagBit bitShift: 29)!
Item was changed:
----- Method: CompiledMethod class>>newMethod:header: (in category 'instance creation') -----
+ newMethod: numberOfBytes header: headerWord
- 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."
- information) is specified the headerWord. 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. Once
- the header of a method is set by this primitive, it cannot be changed in
- any way. Essential. See Object documentation whatIsAPrimitive."
+ <primitive: 79 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingNewMethod: numberOfBytes header: headerWord].
- <primitive: 79>
- (numberOfBytes isInteger and:
- [headerWord isInteger and:
- [numberOfBytes >= 0]]) ifTrue: [
- "args okay; space must be low"
- OutOfMemory signal.
- "retry if user proceeds"
- ^ self newMethod: numberOfBytes header: headerWord
- ].
^self primitiveFailed!
Item was changed:
----- Method: CompiledMethod class>>toReturnConstant:trailerBytes: (in category 'instance creation') -----
toReturnConstant: index trailerBytes: trailer
"Answer an instance of me that is a quick return of the constant
indexed in (true false nil -1 0 1 2)."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index
- !
Item was changed:
----- Method: CompiledMethod class>>toReturnField:trailerBytes: (in category 'instance creation') -----
toReturnField: field trailerBytes: trailer
"Answer an instance of me that is a quick return of the instance variable
indexed by the argument, field."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field
- !
Item was changed:
----- Method: CompiledMethod class>>toReturnSelfTrailerBytes: (in category 'instance creation') -----
toReturnSelfTrailerBytes: trailer
"Answer an instance of me that is a quick return of the instance (^self)."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256
- !
Item was added:
+ ----- Method: CompiledMethod>>bytecodeSetName (in category 'accessing') -----
+ bytecodeSetName
+ ^self encoderClass name copyReplaceAll: 'EncoderFor' with: ''!
Item was changed:
----- Method: CompiledMethod>>headerDescription (in category 'literals') -----
headerDescription
+ "Answer a description containing the information about the form of the
+ receiver and the form of the context needed to run the receiver."
- "Answer a description containing the information about the form of the
- receiver and the form of the context needed to run the receiver."
+ ^(ByteString new: 128) writeStream
+ print: self header; cr;
+ nextPutAll: '"primitive: '; print: self primitive; cr;
+ nextPutAll: ' numArgs: '; print: self numArgs; cr;
+ nextPutAll: ' numTemps: '; print: self numTemps; cr;
+ nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
+ nextPutAll: ' frameSize: '; print: self frameSize; cr;
+ nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
+ nextPut: $"; cr;
+ contents!
- | s |
- s := '' writeStream.
- self header printOn: s.
- s cr; nextPutAll: '"primitive: '.
- self primitive printOn: s.
- s cr; nextPutAll: ' numArgs: '.
- self numArgs printOn: s.
- s cr; nextPutAll: ' numTemps: '.
- self numTemps printOn: s.
- s cr; nextPutAll: ' numLiterals: '.
- self numLiterals printOn: s.
- s cr; nextPutAll: ' frameSize: '.
- self frameSize printOn: s.
- s cr; nextPutAll: ' isClosureCompiled: '.
- self isBlueBookCompiled not printOn: s.
- s nextPut: $"; cr.
- ^ s contents!
Item was changed:
----- Method: CompiledMethod>>numLiterals (in category 'accessing') -----
numLiterals
"Answer the number of literals used by the receiver."
+ ^self header bitAnd: 65535!
- | header |
- ^(header := self header) < 0
- ifTrue: [header bitAnd: 65535]
- ifFalse: [(header bitShift: -9) bitAnd: 16rFF]!
Item was changed:
----- Method: CompiledMethod>>primitive (in category 'accessing') -----
primitive
"Answer the primitive index associated with the receiver.
+ Zero indicates that this is not a primitive method."
+ | initialPC |
+ ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
+ ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
+ ifFalse: [0]!
- Zero indicates that this is not a primitive method.
- In the original header format we currently allow 10 bits of primitive index, but they are
- in two places for backward compatibility. In the new format the primitive index is in the
- last two bytes of a three byte callPrimitive: bytecode. The time to unpack is negligible,
- since the derived primitive function pointer full index is stored in the method cache."
- | header initialPC |
- ^(header := self header) < 0
- ifTrue:
- [(header anyMask: 65536) "Is the hasPrimitive? flag set?"
- ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
- ifFalse: [0]]
- ifFalse:
- [(header bitAnd: 16r1FF) + ((header bitShift: -19) bitAnd: 16r200)]!
Item was changed:
----- Method: ContextPart>>activateReturn:value: (in category 'private') -----
activateReturn: aContext value: value
"Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
+ ^MethodContext
+ sender: self
- ^ self
- activateMethod: ContextPart theReturnMethod
- withArgs: {value}
receiver: aContext
+ method: MethodContext theReturnMethod
+ arguments: {value}!
- class: aContext class!
Item was changed:
----- Method: ContextPart>>doPrimitive:method:receiver:args: (in category 'private') -----
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
+ "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and
+ arguments are given as arguments to this message. If successful, push result and return
+ resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
+ execution needs to be intercepted and simulated to avoid execution running away."
- "Simulate a primitive method whose index is primitiveIndex. The
- simulated receiver and arguments are given as arguments to this message.
- If successful, push result and return resuming context, else ^ PrimitiveFailToken.
- Any primitive which provokes execution needs to be intercepted and simulated
- to avoid execution running away."
| value |
"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
the debugger from entering various run-away activities such as spawning a new
process, etc. Injudicious use results in the debugger not being able to debug
+ interesting code, such as the debugger itself. hence use primitive 19 with care :-)"
- interesting code, such as the debugger itself. hence use primtiive 19 with care :-)"
"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
primitiveIndex = 19 ifTrue:
[ToolSet
debugContext: self
label:'Code simulation error'
contents: nil].
+ ((primitiveIndex between: 201 and: 222)
+ and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
+ [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
+ or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
+ [^receiver simulateValueWithArguments: arguments caller: self].
+ primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
+ [^receiver simulateValueWithArguments: arguments first caller: self]].
- "ContextPart>>blockCopy:; simulated to get startpc right"
- (primitiveIndex = 80 and: [(self objectClass: receiver) includesBehavior: ContextPart])
- ifTrue: [^self push: ((BlockContext newForMethod: receiver method)
- home: receiver home
- startpc: pc + 2
- nargs: (arguments at: 1))].
- (primitiveIndex = 81 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>value[:value:...]"
- ifTrue: [^receiver pushArgs: arguments from: self].
- (primitiveIndex = 82 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>valueWithArguments:"
- ifTrue: [^receiver pushArgs: arguments first from: self].
- primitiveIndex = 83 "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
- ifTrue: [^self send: arguments first
- to: receiver
- with: arguments allButFirst
- super: false].
- primitiveIndex = 84 "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
- ifTrue: [^self send: arguments first
- to: receiver
- with: (arguments at: 2)
- startClass: nil].
- primitiveIndex = 100 "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
- ifTrue: [^self send: arguments first
- to: receiver
- with: (arguments at: 2)
- startClass: (arguments at: 3)].
+ primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
+ [^self send: arguments first to: receiver with: arguments allButFirst super: false].
+ primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
+ [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
+ primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
+ [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
+
"Mutex>>primitiveEnterCriticalSection
Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
[| active effective |
active := Processor activeProcess.
effective := active effectiveProcess.
"active == effective"
value := primitiveIndex = 186
ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
+ ^(self isPrimFailToken: value)
- ^((self objectClass: value) == Array
- and: [value size = 2
- and: [value first == PrimitiveFailToken]])
ifTrue: [value]
ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
[^MethodContext
sender: self
receiver: receiver
method: (arguments at: 2)
arguments: (arguments at: 1)].
"Closure primitives"
(primitiveIndex = 200 and: [self == receiver]) ifTrue:
"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
[^self push: (BlockClosure
outerContext: receiver
startpc: pc + 2
numArgs: arguments first
copiedValues: arguments last)].
- ((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
- or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
- [^receiver simulateValueWithArguments: arguments caller: self].
- primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
- [^receiver simulateValueWithArguments: arguments first caller: self].
primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
[(arguments size = 2
and: [arguments first isInteger
and: [(self objectClass: arguments last) == Array]]) ifFalse:
[^ContextPart primitiveFailTokenFor: nil].
^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method"
ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
ifFalse:
[primitiveIndex = 117 "named primitives"
ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
+ ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
+
+ ^(self isPrimFailToken: value)
- ifFalse:
- [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
- ^((self objectClass: value) == Array
- and: [value size = 2
- and: [value first == PrimitiveFailToken]])
ifTrue: [value]
ifFalse: [self push: value]!
Item was added:
+ ----- Method: ContextPart>>isPrimFailToken: (in category 'private') -----
+ isPrimFailToken: anObject
+ ^(self objectClass: anObject) == Array
+ and: [anObject size = 2
+ and: [anObject first == PrimitiveFailToken]]!
Item was added:
+ ----- Method: ContextPart>>send:to:with:lookupIn: (in category 'controlling') -----
+ send: selector to: rcvr with: arguments lookupIn: lookupClass
+ "Simulate the action of sending a message with selector and arguments
+ to rcvr. The argument, lookupClass, is the class in which to lookup the
+ message. This is the receiver's class for normal messages, but for super
+ messages it will be some specific class related to the source method."
+
+ | meth primIndex val ctxt |
+ (meth := lookupClass lookupSelector: selector) ifNil:
+ [^self send: #doesNotUnderstand:
+ to: rcvr
+ with: {Message selector: selector arguments: arguments}
+ lookupIn: lookupClass].
+ (primIndex := meth primitive) > 0 ifTrue:
+ [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
+ (self isPrimFailToken: val) ifFalse:
+ [^val]].
+ (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
+ [^self error: 'Simulated message ', arguments first selector, ' not understood'].
+ ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
+ primIndex > 0 ifTrue:
+ [ctxt failPrimitiveWith: val].
+ ^ctxt!
Item was changed:
----- Method: ContextPart>>send:to:with:super: (in category 'controlling') -----
+ send: selector to: rcvr with: arguments super: superFlag
+ "Simulate the action of sending a message with selector arguments
+ to rcvr. The argument, superFlag, tells whether the receiver of the
+ message was specified with 'super' in the source method."
- send: selector to: rcvr with: args super: superFlag
- "Simulate the action of sending a message with selector, selector, and
- arguments, args, to receiver. The argument, superFlag, tells whether the
- receiver of the message was specified with 'super' in the source method."
+ ^self send: selector
+ to: rcvr
+ with: arguments
+ lookupIn: (superFlag
+ ifTrue: [self method methodClassAssociation value superclass]
+ ifFalse: [self objectClass: rcvr])!
- | class meth val ctxt |
- class := superFlag
- ifTrue: [self method methodClassAssociation value superclass]
- ifFalse: [self objectClass: rcvr].
- meth := class lookupSelector: selector.
- meth == nil ifTrue:
- [^self
- send: #doesNotUnderstand:
- to: rcvr
- with: (Array with: (Message selector: selector arguments: args))
- super: superFlag].
- val := self tryPrimitiveFor: meth receiver: rcvr args: args.
- ((self objectClass: val) == Array
- and: [val size = 2
- and: [val first == PrimitiveFailToken]]) ifFalse:
- [^val].
- (selector == #doesNotUnderstand:
- and: [class == ProtoObject]) ifTrue:
- [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood'].
- ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class.
- ((self objectClass: val) == Array
- and: [val size = 2
- and: [val first == PrimitiveFailToken
- and: [val last notNil
- and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue:
- [ctxt at: ctxt stackPtr put: val last].
- ^ctxt!
Item was changed:
----- Method: ContextPart>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') -----
tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
+ "Invoke the named primitive for aCompiledMethod, answering its result, or,
+ if the primiitve fails, answering the error code."
- | selector theMethod spec receiverClass |
<primitive: 218 error: ec>
ec ifNotNil:
["If ec is an integer other than -1 there was a problem with primitive 218,
not with the external primitive itself. -1 indicates a generic failure (where
ec should be nil) but ec = nil means primitive 218 is not implemented. So
interpret -1 to mean the external primitive failed with a nil error code."
ec isInteger ifTrue:
[ec = -1
ifTrue: [ec := nil]
+ ifFalse: [self primitiveFailed]]].
+ ^self class primitiveFailTokenFor: ec!
- ifFalse: [self primitiveFailed]].
- ^{PrimitiveFailToken. ec}].
- "Assume a nil error code implies the primitive is not implemented and fall back on the old code."
- "Hack. Attempt to execute the named primitive from the given compiled method"
- arguments size > 8 ifTrue:
- [^{PrimitiveFailToken. nil}].
- selector := #(
- tryNamedPrimitive
- tryNamedPrimitive:
- tryNamedPrimitive:with:
- tryNamedPrimitive:with:with:
- tryNamedPrimitive:with:with:with:
- tryNamedPrimitive:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:with:with:) at: arguments size+1.
- receiverClass := self objectClass: aReceiver.
- theMethod := receiverClass lookupSelector: selector.
- theMethod == nil ifTrue:
- [^{PrimitiveFailToken. nil}].
- spec := theMethod literalAt: 1.
- spec replaceFrom: 1 to: spec size with: (aCompiledMethod literalAt: 1) startingAt: 1.
- Smalltalk unbindExternalPrimitives.
- ^self object: aReceiver perform: selector withArguments: arguments inClass: receiverClass!
Item was added:
+ ----- Method: InstructionClient>>callPrimitive: (in category 'instruction decoding') -----
+ callPrimitive: pimIndex
+ "V3PlusClosures: 139 10001011 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ NewsqueakV4: 249 11111001 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + ( jjjjjjj * 256)
+ m=1 means inlined primitive, no hard return after execution."!
Item was added:
+ ----- Method: InstructionPrinter>>callPrimitive: (in category 'instruction decoding') -----
+ callPrimitive: index
+ "Print the callPrimitive."
+
+ self print: 'callPrimtive: ' , index printString!
Item was changed:
----- Method: InstructionStream>>interpretV3ClosuresExtension:in:for: (in category 'decoding - private - v3 plus closures') -----
interpretV3ClosuresExtension: offset in: method for: client
| type offset2 byte2 byte3 byte4 |
offset <= 6 ifTrue:
["Extended op codes 128-134"
byte2 := method at: pc. pc := pc + 1.
offset <= 2 ifTrue:
["128-130: extended pushes and pops"
type := byte2 // 64.
offset2 := byte2 \\ 64.
offset = 0 ifTrue:
[type = 0 ifTrue: [^client pushReceiverVariable: offset2].
type = 1 ifTrue: [^client pushTemporaryVariable: offset2].
type = 2 ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)].
type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]].
offset = 1 ifTrue:
[type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2].
type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2].
type = 2 ifTrue: [self error: 'illegalStore'].
type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
offset = 2 ifTrue:
[type = 0 ifTrue: [^client popIntoReceiverVariable: offset2].
type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2].
type = 2 ifTrue: [self error: 'illegalStore'].
type = 3 ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
"131-134: extended sends"
offset = 3 ifTrue: "Single extended send"
[^client send: (method literalAt: byte2 \\ 32 + 1)
super: false numArgs: byte2 // 32].
offset = 4 ifTrue: "Double extended do-anything"
[byte3 := method at: pc. pc := pc + 1.
type := byte2 // 32.
type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1)
super: false numArgs: byte2 \\ 32].
type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1)
super: true numArgs: byte2 \\ 32].
type = 2 ifTrue: [^client pushReceiverVariable: byte3].
type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)].
type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)].
type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3].
type = 6 ifTrue: [^client popIntoReceiverVariable: byte3].
type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
offset = 5 ifTrue: "Single extended send to super"
[^client send: (method literalAt: byte2 \\ 32 + 1)
super: true
numArgs: byte2 // 32].
offset = 6 ifTrue: "Second extended send"
[^client send: (method literalAt: byte2 \\ 64 + 1)
super: false
numArgs: byte2 // 64]].
offset = 7 ifTrue: [^client doPop].
offset = 8 ifTrue: [^client doDup].
offset = 9 ifTrue: [^client pushActiveContext].
byte2 := method at: pc. pc := pc + 1.
offset = 10 ifTrue:
[^byte2 < 128
ifTrue: [client pushNewArrayOfSize: byte2]
ifFalse: [client pushConsArrayWithElements: byte2 - 128]].
- offset = 11 ifTrue: [^self error: 'unusedBytecode'].
byte3 := method at: pc. pc := pc + 1.
+ offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)].
offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3].
offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
"offset = 15"
byte4 := method at: pc. pc := pc + 1.
^client
pushClosureCopyNumCopiedValues: (byte2 bitShift: -4)
numArgs: (byte2 bitAnd: 16rF)
blockSize: (byte3 * 256) + byte4!
Item was changed:
----- Method: Integer class>>initialize (in category 'class initialization') -----
+ initialize
+ "Integer initialize"
+ self initializeLowBitPerByteTable!
- initialize "Integer initialize"
- "Ensure we have the right compact class index"
-
- "LPI has been a compact class forever - just ensure basic correctness"
- (LargePositiveInteger indexIfCompact = 5) ifFalse:[
- (Smalltalk compactClassesArray at: 5)
- ifNil:[LargePositiveInteger becomeCompactSimplyAt: 5]
- ifNotNil:[self error: 'Unexpected compact class setup']].
-
- "Cog requires LNI to be compact at 4 (replacing PseudoContext)"
- (LargeNegativeInteger indexIfCompact = 4) ifFalse:[
- "PseudoContext will likely get removed at some point so write this test
- without introducing a hard dependency"
- (Smalltalk compactClassesArray at: 4) name == #PseudoContext
- ifTrue:[Smalltalk compactClassesArray at: 4 put: nil].
- (Smalltalk compactClassesArray at: 4)
- ifNil:[LargeNegativeInteger becomeCompactSimplyAt: 4]
- ifNotNil:[self error: 'Unexpected compact class setup']].
-
- self initializeLowBitPerByteTable
- !
Item was added:
+ ----- Method: MethodContext class>>allInstances (in category 'enumerating') -----
+ allInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since this context has been created only to
+ compute the existing instances."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ insts nextPut: inst.
+ inst := next].
+ ^insts contents!
Item was changed:
----- Method: MethodContext class>>allInstancesDo: (in category 'private') -----
allInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since evaluation of aBlock will create new contexts."
- "Only count until thisContext since evaluation of aBlock will create new contexts."
- | inst next |
inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
- [inst == thisContext] whileFalse:[
- next := inst nextInstance.
- aBlock value: inst.
- inst := next]
- !
Item was added:
+ ----- Method: MethodContext>>failPrimitiveWith: (in category 'system simulation') -----
+ failPrimitiveWith: maybePrimFailToken
+ "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive:
+ bytecode and store the primitive fail code if there is one and the method consumes it."
+ self skipCallPrimitive.
+ ((self isPrimFailToken: maybePrimFailToken)
+ and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
+ [self at: stackp put: maybePrimFailToken last]!
Item was changed:
----- Method: ProtoObject>>scaledIdentityHash (in category 'comparing') -----
scaledIdentityHash
"For identityHash values returned by primitive 75, answer
+ such values times 2^8. Otherwise, match the existing
+ identityHash implementation"
- such values times 2^18. Otherwise, match the existing
- identityHash implementation"
+ ^self identityHash * 256 "bitShift: 8"!
- ^self identityHash * 262144 "bitShift: 18"!
Item was changed:
==== ERROR ===
Error: Unrecognized class type
27 September 2014 8:29:49.152 pm
VM: unix - a SmalltalkImage
Image: Squeak3.11alpha [latest update: #8824]
SecurityManager state:
Restricted: false
FileAccess: true
SocketAccess: true
Working Dir /home/squeaksource
Trusted Dir /home/squeaksource/secure
Untrusted Dir /home/squeaksource/My Squeak
MCClassDefinition(Object)>>error:
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
aString: 'Unrecognized class type'
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
MCClassDefinition>>kindOfSubclass
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
MCClassDefinition>>printDefinitionOn:
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
stream: a WriteStream
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
[] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
Receiver: a MCDiffyTextWriter
Arguments and temporary variables:
definition: a WriteStream
s: a MCClassDefinition(SmallInteger)
Receiver's instance variables:
stream: a WriteStream
initStream: nil
--- The full stack ---
MCClassDefinition(Object)>>error:
MCClassDefinition>>kindOfSubclass
MCClassDefinition>>printDefinitionOn:
[] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
String class(SequenceableCollection class)>>new:streamContents:
String class(SequenceableCollection class)>>streamContents:
MCDiffyTextWriter(MCTextWriter)>>chunkContents:
MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
MCDiffyTextWriter(MCStWriter)>>visitClassDefinition:
MCClassDefinition>>accept:
[] in MCDiffyTextWriter(MCTextWriter)>>visitInFork:
String class(SequenceableCollection class)>>new:streamContents:
String class(SequenceableCollection class)>>streamContents:
MCDiffyTextWriter(MCTextWriter)>>visitInFork:
MCDiffyTextWriter>>writePatchFrom:to:
MCDiffyTextWriter>>writeModification:
[] in MCDiffyTextWriter>>writePatch:
SortedCollection(OrderedCollection)>>do:
MCDiffyTextWriter>>writePatch:
SSDiffyTextWriter>>writePatch:
[] in SSDiffyTextWriter>>writeVersion:for:
BlockClosure>>on:do:
SSDiffyTextWriter>>writeVersion:for:
[] in SSEMailSubscription>>versionAdded:to:
BlockClosure>>on:do:
SSEMailSubscription>>versionAdded:to:
[] in [] in SSProject>>versionAdded:
[] in BlockClosure>>newProcess
1
0
Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel.spur-ul.875.mcz
==================== Summary ====================
Name: Kernel.spur-ul.875
Author: eem
Time: 27 September 2014, 1:16:59.187 pm
UUID: 3e4a6002-9948-4f78-a687-78b70614ac74
Ancestors: Kernel-ul.875
Kernel-ul.875 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.208
- improved Date >> #printFormat:
- added #isZero to LargeIntegers
=============== Diff against Kernel-ul.875 ===============
Item was changed:
----- Method: Behavior>>allInstances (in category 'accessing instances and variables') -----
+ allInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == nil] whileFalse:
+ [next := inst nextInstance.
+ (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
+ inst := next].
+ ^insts contents!
- allInstances
- "Answer a collection of all current instances of the receiver."
-
- | all |
- all := OrderedCollection new.
- self allInstancesDo: [:x | x == all ifFalse: [all add: x]].
- ^ all asArray
- !
Item was changed:
----- Method: Behavior>>allInstancesDo: (in category 'enumerating') -----
+ allInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst."
- allInstancesDo: aBlock
- "Evaluate the argument, aBlock, for each of the current instances of the
- receiver.
-
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst."
- | inst next |
inst := self someInstance.
+ [inst == nil] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
- [inst == nil]
- whileFalse:
- [
- next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was added:
+ ----- Method: Behavior>>allInstancesOrNil (in category 'enumerating') -----
+ allInstancesOrNil
+ "Answer all instances of the receiver, or nil if the primitive
+ fails, which it may be due to being out of memory."
+ <primitive: 177>
+ ^nil!
Item was changed:
----- Method: Behavior>>basicNew (in category 'instance creation') -----
basicNew
"Primitive. Answer an instance of the receiver (which is a class) with no
+ indexable variables. Fail if the class is indexable. Essential. See Object
+ documentation whatIsAPrimitive.
+
+ If the primitive fails because space is low then the scavenger will run
+ before the method is activated. Check that space was low and retry
+ via handleFailingBasicNew if so."
- indexable variables. Fail if the class is indexable. Essential. See Object
- documentation whatIsAPrimitive."
+ <primitive: 70 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingBasicNew].
+ self isVariable ifTrue: [^self basicNew: 0].
+ self primitiveFailed!
- <primitive: 70>
- self isVariable ifTrue: [ ^ self basicNew: 0 ].
- "space must be low"
- OutOfMemory signal.
- ^ self basicNew "retry if user proceeds"
- !
Item was changed:
----- Method: Behavior>>basicNew: (in category 'instance creation') -----
+ basicNew: sizeRequested
+ "Primitive. Answer an instance of this class with the number of indexable
+ variables specified by the argument, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive.
+
+ If the primitive fails because space is low then the scavenger will run before the
+ method is activated. Check args and retry via handleFailingBasicNew: if they're OK."
- basicNew: sizeRequested
- "Primitive. Answer an instance of this class with the number
- of indexable variables specified by the argument, sizeRequested.
- Fail if this class is not indexable or if the argument is not a
- positive Integer, or if there is not enough memory available.
- Essential. See Object documentation whatIsAPrimitive."
+ <primitive: 71 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingBasicNew: sizeRequested].
- <primitive: 71>
self isVariable ifFalse:
[self error: self printString, ' cannot have variable sized instances'].
- (sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue:
- ["arg okay; space must be low."
- OutOfMemory signal.
- ^ self basicNew: sizeRequested "retry if user proceeds"].
self primitiveFailed!
Item was added:
+ ----- Method: Behavior>>byteSizeOfInstance (in category 'accessing instances and variables') -----
+ byteSizeOfInstance
+ "Answer the total memory size of an instance of the receiver."
+
+ <primitive: 181 error: ec>
+ self isVariable ifTrue:
+ [^self byteSizeOfInstanceOfSize: 0].
+ self primitiveFailed!
Item was added:
+ ----- Method: Behavior>>byteSizeOfInstanceOfSize: (in category 'accessing instances and variables') -----
+ byteSizeOfInstanceOfSize: basicSize
+ "Answer the total memory size of an instance of the receiver
+ with the given number of indexable instance variables."
+
+ <primitive: 181 error: ec>
+ self isVariable
+ ifTrue: "If the primitive overflowed answer a close approximation"
+ [(basicSize isInteger
+ and: [basicSize >= 16r1000000]) ifTrue:
+ [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
+ - (self byteSizeOfInstanceOfSize: 0)]]
+ ifFalse:
+ [basicSize = 0 ifTrue:
+ [^self byteSizeOfInstance]].
+ self primitiveFailed!
Item was added:
+ ----- 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 (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 added:
+ ----- Method: Behavior>>handleFailingBasicNew (in category 'private') -----
+ handleFailingBasicNew
+ "handleFailingBasicNew gets sent after basicNew 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 70>
+ Smalltalk garbageCollect < 1048576 ifTrue:
+ [Smalltalk growMemoryByAtLeast: 1048576].
+ ^self handleFailingFailingBasicNew "retry after global garbage collect"!
Item was added:
+ ----- Method: Behavior>>handleFailingBasicNew: (in category 'private') -----
+ handleFailingBasicNew: sizeRequested
+ "handleFailingBasicNew: gets sent after basicNew: 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 71>
+ | bytesRequested |
+ bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
+ Smalltalk garbageCollect < bytesRequested ifTrue:
+ [Smalltalk growMemoryByAtLeast: bytesRequested].
+ "retry after global garbage collect and possible grow"
+ ^self handleFailingFailingBasicNew: sizeRequested!
Item was added:
+ ----- Method: Behavior>>handleFailingFailingBasicNew (in category 'private') -----
+ handleFailingFailingBasicNew
+ "This basicNew 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 70>
+ "space must be low"
+ OutOfMemory signal.
+ ^self basicNew "retry if user proceeds"!
Item was added:
+ ----- Method: Behavior>>handleFailingFailingBasicNew: (in category 'private') -----
+ handleFailingFailingBasicNew: sizeRequested
+ "This basicNew: 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 71>
+ "space must be low."
+ OutOfMemory signal.
+ ^self basicNew: sizeRequested "retry if user proceeds"!
Item was added:
+ ----- Method: Behavior>>identityHash (in category 'comparing') -----
+ identityHash
+ "Answer a SmallInteger whose value is related to the receiver's identity.
+ Behavior implements identityHash to allow the VM to use an object representation which
+ does not include a direct reference to an object's class in an object. If the VM is using
+ this implementation then classes are held in a class table and instances contain the index
+ of their class in the table. A class's class table index is its identityHash so that an instance
+ can be created without searching the table for a class's index. The VM uses this primitive
+ to enter the class into the class table, assigning its identityHash with an as yet unused
+ class table index. If this primitive fails it means that the class table is full. In Spur as of
+ 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
+
+ Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
+
+ <primitive: 175>
+ self primitiveFailed!
Item was changed:
----- Method: Behavior>>indexIfCompact (in category 'private') -----
indexIfCompact
+ "Backward compatibility with the Squeak V3 object format.
+ Spur does not have a distinction between compact and non-compact classes."
+ ^0!
- "If these 5 bits are non-zero, then instances of this class
- will be compact. It is crucial that there be an entry in
- Smalltalk compactClassesArray for any class so optimized.
- See the msgs becomeCompact and becomeUncompact."
- ^ (format bitShift: -11) bitAnd: 16r1F
- "
- Smalltalk compactClassesArray doWithIndex:
- [:c :i | c == nil ifFalse:
- [c indexIfCompact = i ifFalse: [self halt]]]
- "!
Item was changed:
----- Method: Behavior>>instSize (in category 'testing') -----
instSize
"Answer the number of named instance variables
+ (as opposed to indexed variables) of the receiver.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>"
+ ^format bitAnd: 16rFFFF!
- (as opposed to indexed variables) of the receiver."
-
- self flag: #instSizeChange. "Smalltalk browseAllCallsOn: #instSizeChange"
- "
- NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
- When we revise the image format, it should become...
- ^ ((format bitShift: -1) bitAnd: 16rFF) - 1
- Note also that every other method in this category will require
- 2 bits more of right shift after the change.
- "
- ^ ((format bitShift: -10) bitAnd: 16rC0) + ((format bitShift: -1) bitAnd: 16r3F) - 1!
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 (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)"
+ ^(format bitShift: -16) bitAnd: 16r1F!
- ^ (format bitShift: -7) bitAnd: 16rF!
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 (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!
- "Answer whether the receiver contains just bits (not pointers)."
-
- ^ self instSpec >= 6!
Item was changed:
----- Method: Behavior>>isBytes (in category 'testing') -----
isBytes
+ "Answer whether the receiver has 8-bit 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 (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!
- "Answer whether the receiver has 8-bit instance variables."
-
- ^ self instSpec >= 8!
Item was added:
+ ----- Method: Behavior>>isEphemeronClass (in category 'testing') -----
+ isEphemeronClass
+ "Answer whether the receiver has ephemeral instance variables. The garbage collector will
+ fire (queue for finalization) any ephemeron whose first instance variable is not referenced
+ other than from the transitive closure of references from ephemerons. Hence referring to
+ an object from the first inst var of an ephemeron will cause the ephemeron to fire when
+ the rest of the system does not refer to the object and that object is ready to be collected.
+ Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
+ from firing, ephemerons may act as the associations in weak dictionaries such that the value
+ (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
+ other than from ephemerons. Ephemerons can therefore be used to implement instance-based
+ pre-mortem finalization."
+ ^self instSpec = 5!
Item was added:
+ ----- Method: Behavior>>isImmediateClass (in category 'testing') -----
+ isImmediateClass
+ "Answer whether the receiver has immediate instances. Immediate instances
+ store their value in their object pointer, not in an object body. Hence immediates
+ take no space and are immutable. The immediates are distinguished by tag bits
+ in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit
+ system SmallIntegers are 31-bit signed integers and Characters are 30-bit
+ unsigned character codes."
+ ^self instSpec = 7!
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 (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]]!
- "Answer whether the receiver has indexable variables."
-
- ^ self instSpec >= 2!
Item was changed:
----- Method: Behavior>>kindOfSubclass (in category 'testing class hierarchy') -----
kindOfSubclass
+ "Answer a String that is the keyword that describes the receiver's kind of subclass,
+ either a regular subclass, a variableSubclass, a variableByteSubclass,
+ a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
+ c.f. typeOfClass"
+ ^self isVariable
+ ifTrue:
+ [self isBits
+ ifTrue:
+ [self isBytes
+ ifTrue: [' variableByteSubclass: ']
+ ifFalse: [' variableWordSubclass: ']]
+ ifFalse:
+ [self isWeak
+ ifTrue: [' weakSubclass: ']
+ ifFalse: [' variableSubclass: ']]]
+ ifFalse:
+ [self isImmediateClass
+ ifTrue: [' immediateSubclass: ']
+ ifFalse:
+ [self isEphemeronClass
+ ifTrue: [' ephemeronSubclass: ']
+ ifFalse: [' subclass: ']]]!
- "Answer a String that is the keyword that describes the receiver's kind
- of subclass, either a regular subclass, a variableSubclass, a
- variableByteSubclass, a variableWordSubclass, or a weakSubclass."
- self isWeak
- ifTrue: [^ ' weakSubclass: '].
- ^ self isVariable
- ifTrue: [self isBits
- ifTrue: [self isBytes
- ifTrue: [ ' variableByteSubclass: ']
- ifFalse: [ ' variableWordSubclass: ']]
- ifFalse: [ ' variableSubclass: ']]
- ifFalse: [ ' subclass: ']!
Item was changed:
----- Method: Behavior>>shouldNotBeRedefined (in category 'testing') -----
shouldNotBeRedefined
+ "Answer if the receiver should not be redefined.
+ The assumption is that classes in Smalltalk specialObjects and
+ instance-specific Behaviors should not be redefined"
- "Return true if the receiver should not be redefined.
- The assumption is that compact classes,
- classes in Smalltalk specialObjects and
- Behaviors should not be redefined"
+ ^(Smalltalk specialObjectsArray
+ identityIndexOf: self
+ ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!
- ^(Smalltalk compactClassesArray includes: self)
- or:[(Smalltalk specialObjectsArray includes: self)
- or:[self isKindOf: self]]!
Item was changed:
----- Method: Behavior>>typeOfClass (in category 'accessing') -----
typeOfClass
+ "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass"
+ self isBytes ifTrue:
+ [^self instSpec = CompiledMethod instSpec
+ ifTrue: [#compiledMethod] "Very special!!"
+ ifFalse: [#bytes]].
+ (self isWords and: [self isPointers not]) ifTrue:
+ [^self instSpec = SmallInteger instSpec
+ ifTrue: [#immediate] "Very special!!"
+ ifFalse: [#words]].
+ self isWeak ifTrue: [^#weak].
+ self isVariable ifTrue: [^#variable].
+ self isEphemeronClass ifTrue: [^#ephemeron].
+ ^#normal!
- "Answer a symbol uniquely describing the type of the receiver"
- self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!"
- self isBytes ifTrue:[^#bytes].
- (self isWords and:[self isPointers not]) ifTrue:[^#words].
- self isWeak ifTrue:[^#weak].
- self isVariable ifTrue:[^#variable].
- ^#normal.!
Item was changed:
----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') -----
simulateValueWithArguments: anArray caller: aContext
+ "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
| newContext sz |
- (anArray class ~~ Array
- or: [numArgs ~= anArray size]) ifTrue:
- [^ContextPart primitiveFailTokenFor: nil].
newContext := (MethodContext newForMethod: outerContext method)
setSender: aContext
receiver: outerContext receiver
method: outerContext method
closure: self
startpc: startpc.
+ ((newContext objectClass: anArray) ~~ Array
+ or: [numArgs ~= anArray size]) ifTrue:
+ [^ContextPart primitiveFailTokenFor: nil].
sz := self basicSize.
newContext stackp: sz + numArgs.
1 to: numArgs do:
[:i| newContext at: i put: (anArray at: i)].
1 to: sz do:
[:i| newContext at: i + numArgs put: (self at: i)].
^newContext!
Item was added:
+ ----- Method: Class>>immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
+ immediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new
+ immediate class as a subclass of an existing class (the receiver)."
+ ^ClassBuilder new
+ superclass: self
+ immediateSubclass: t
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was changed:
----- Method: ClassBuilder>>computeFormat:instSize:forSuper:ccIndex: (in category 'class format') -----
computeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
"Compute the new format for making oldClass a subclass of newSuper.
+ Answer the format or nil if there is any problem."
- Return the format or nil if there is any problem."
| instSize isVar isWords isPointers isWeak |
type == #compiledMethod ifTrue:
+ [newInstSize > 0 ifTrue:
+ [self error: 'A compiled method class cannot have named instance variables'.
+ ^nil].
+ ^CompiledMethod format].
- [^(CompiledMethod format
- bitClear: (16r1F bitShift: 11))
- bitOr: (ccIndex bitShift: 11)].
instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
+ instSize > 65535 ifTrue:
- instSize > 254 ifTrue:
[self error: 'Class has too many instance variables (', instSize printString,')'.
^nil].
type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
+ type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
+ type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
+ (isPointers not and: [instSize > 0]) ifTrue:
+ [self error: 'A non-pointer class cannot have named instance variables'.
- (isPointers not and:[instSize > 0]) ifTrue:
- [self error:'A non-pointer class cannot have instance variables'.
^nil].
+ ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
- ^(self format: instSize
- variable: isVar
- words: isWords
- pointers: isPointers
- weak: isWeak) + (ccIndex bitShift: 11).!
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 (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 |
- format: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
- "Compute the format for the given instance specfication."
- | cClass instSpec sizeHiBits fmt |
- self flag: #instSizeChange.
- "
- Smalltalk browseAllCallsOn: #instSizeChange.
- Smalltalk browseAllImplementorsOf: #fixedFieldsOf:.
- Smalltalk browseAllImplementorsOf: #instantiateClass:indexableSize:.
- "
- "
- NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
- For now the format word is...
- <2 bits=instSize//64><5 bits=cClass><4 bits=instSpec><6 bits=instSize\\64><1 bit=0>
- But when we revise the image format, it should become...
- <5 bits=cClass><4 bits=instSpec><8 bits=instSize><1 bit=0>
- "
- sizeHiBits := (nInstVars+1) // 64.
- cClass := 0. "for now"
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!
- ifTrue:[4]
- ifFalse:[isPointers
- ifTrue: [isVar
- ifTrue: [nInstVars>0 ifTrue: [3] ifFalse: [2]]
- ifFalse: [nInstVars>0 ifTrue: [1] ifFalse: [0]]]
- ifFalse: [isWords ifTrue: [6] ifFalse: [8]]].
- fmt := sizeHiBits.
- fmt := (fmt bitShift: 5) + cClass.
- fmt := (fmt bitShift: 4) + instSpec.
- fmt := (fmt bitShift: 6) + ((nInstVars+1)\\64). "+1 since prim size field includes header"
- fmt := (fmt bitShift: 1). "This shift plus integer bit lets wordSize work like byteSize"
- ^fmt!
Item was added:
+ ----- Method: ClassBuilder>>superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
+ superclass: aClass
+ immediateSubclass: t instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a
+ new immediate class as a subclass of an existing class."
+ | env |
+ aClass instSize > 0
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
+ aClass isVariable
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
+ aClass isPointers
+ ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
+ "Cope with pre-environment and environment versions. Simplify asap."
+ env := (Smalltalk classNamed: #EnvironmentRequest)
+ ifNil: [aClass environment]
+ ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
+ ^self
+ name: t
+ inEnvironment: env
+ subclassOf: aClass
+ type: #immediate
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was changed:
----- Method: ClassBuilder>>update:to: (in category 'class mutation') -----
update: oldClass to: newClass
+ "Convert oldClass, all its instances and possibly its meta class into newClass,
+ instances of newClass and possibly its meta class. The process is surprisingly
+ simple in its implementation and surprisingly complex in its nuances and potentially
+ bad side effects.
+ We can rely on two assumptions (which are critical):
+ #1: The method #updateInstancesFrom: will not create any lasting pointers to
+ 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
+ a become of the old vs. the new instances and therefore it will not create
+ pointers to *new* instances before the #become: which are *old* afterwards)
+ #2: The non-preemptive execution of the critical piece of code guarantees that
+ nobody can get a hold by 'other means' (such as process interruption and
+ reflection) on the old instances.
+ Given the above two, we know that after #updateInstancesFrom: there are no pointers
+ to any old instances. After the forwarding become there will be no pointers to the old
+ class or meta class either.
+ Andreas Raab, 2/27/2003 23:42"
- "Convert oldClass, all its instances and possibly its meta class into newClass, instances of newClass and possibly its meta class. The process is surprisingly simple in its implementation and surprisingly complex in its nuances and potentially bad side effects.
- We can rely on two assumptions (which are critical):
- #1: The method #updateInstancesFrom: will not create any lasting pointers to 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do a become of the old vs. the new instances and therefore it will not create pointers to *new* instances before the #become: which are *old* afterwards)
- #2: The non-preemptive execution of the critical piece of code guarantees that nobody can get a hold by 'other means' (such as process interruption and reflection) on the old instances.
- Given the above two, we know that after #updateInstancesFrom: there are no pointer to any old instances. After the forwarding become there will be no pointers to the old class or meta class either. Meaning that if we throw in a nice fat GC at the end of the critical block, everything will be gone (but see the comment right there). There's no need to worry.
- "
| meta |
meta := oldClass isMeta.
"Note: Everything from here on will run without the ability to get interrupted
to prevent any other process to create new instances of the old class."
+ ["Note: The following removal may look somewhat obscure and needs an explanation.
+ When we mutate the class hierarchy we create new classes for any existing subclass.
+ So it may look as if we don't have to remove the old class from its superclass. However,
+ at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
+ created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
+ subclasses. Since the #become: below will transparently replace the pointers to oldClass
+ with newClass the superclass would have newClass in its subclasses TWICE. With rather
+ unclear effects if we consider that we may convert the meta-class hierarchy itself (which
+ is derived from the non-meta class hierarchy).
+ Due to this problem ALL classes are removed from their superclass just prior to converting
+ them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
+ effectively remove the oldClass (becomeForward:) just a few lines below."
- [
- "Note: The following removal may look somewhat obscure and needs an explanation. When we mutate the class hierarchy we create new classes for any existing subclass. So it may look as if we don't have to remove the old class from its superclass. However, at the top of the hierarchy (the first class we reshape) that superclass itself is not newly created so therefore it will hold both the oldClass and newClass in its (obsolete or not) subclasses. Since the #become: below will transparently replace the pointers to oldClass with newClass the superclass would have newClass in its subclasses TWICE. With rather unclear effects if we consider that we may convert the meta-class hierarchy itself (which is derived from the non-meta class hierarchy).
- Due to this problem ALL classes are removed from their superclass just prior to converting them. Here, breaking the superclass/subclass invariant really doesn't matter since we will effectively remove the oldClass (become+GC) just a few lines below."
oldClass superclass removeSubclass: oldClass.
oldClass superclass removeObsoleteSubclass: oldClass.
"make sure that the VM cache is clean"
oldClass methodDict do: [:cm | cm flushCache].
"Convert the instances of oldClass into instances of newClass"
newClass updateInstancesFrom: oldClass.
meta
ifTrue:
[oldClass becomeForward: newClass.
oldClass updateMethodBindingsTo: oldClass binding]
ifFalse:
[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
oldClass updateMethodBindingsTo: oldClass binding.
oldClass class updateMethodBindingsTo: oldClass class binding].
+ "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
+ to ensure no old instances existed after the becomeForward:. Without the GC it was possible
+ to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
+ updated references from the old objects to new objects but didn't destroy the old objects.
+ But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
+ valueUnpreemptively!
- Smalltalk garbageCollect.
-
- "Warning: Read this before you even think about removing the GC. Yes, it slows us down. Quite heavily if you have a large image. However, there's no good and simple alternative here, since unfortunately, #become: does change class pointers. What happens is that after the above become all of the instances of the old class will have a class pointer identifying them as instances of newClass. If we get our hands on any of these instances we will break immediately since their expected instance layout (that of its class, e.g., newClass) will not match their actual instance layout (that of oldClass). And getting your hands on any of those instances is really simple - just reshaping one class two times in rapid succession will do it. Reflection techniques, interrupts, etc. will only add to this problem. In the case of Metaclass things get even worse since when we recompile the entire class hierarchy we will recompile both, Metaclass and its instances (and some of its instances will have the old and some the new layout).
-
- The only easy solution to this problem would be to 'fix up' the class pointers of the old instances to point to the old class (using primitiveChangeClassTo:). But this won't work either - as we do a one-way become we would have to search the entire object memory for the oldClass and couldn't even clearly identify it unless we give it some 'special token' which sounds quite error-prone. If you really need to get rid of the GC here are some alternatives:
-
- On the image level, one could create a copy of the oldClass before becoming it into the new class and, after becoming it, 'fix up' the old instances. That would certainly work but it sounds quite complex, as we need to make sure we're not breaking any of the superclass/subclass meta/non-meta class variants.
-
- Alternatively, fix up #becomeForward on the VM-level to 'dump the source objects' of #become. This would be quite doable (just 'convert' them into a well known special class such as bitmap) yet it has problems if (accidentally or not) one of the objects in #become: appears on 'both sides of the fence' (right now, this will work ... in a way ... even though the consequences are unclear).
-
- Another alternative is to provide a dedicated primitive for this (instead of using it implicitly in become) which would allow us to dump all the existing instances right here. This is equivalent to a more general primitiveChangeClassTo: and might be worthwhile but it would likely have to keep in mind the differences between bits and pointer thingies etc.
-
- Since all of the alternatives seem rather complex and magical compared to a straight-forward GC it seems best to stick with the GC solution for now. If someone has a real need to fix this problem, that person will likely be motivated enough to check out the alternatives. Personally I'd probably go for #1 (copy the old class and remap the instances to it) since it's a solution that could be easily reverted from within the image if there's any problem with it."
-
- ] valueUnpreemptively.
- !
Item was changed:
ByteArray variableByteSubclass: #CompiledMethod
instanceVariableNames: ''
classVariableNames: 'LargeFrame PrimaryBytecodeSetEncoderClass SecondaryBytecodeSetEncoderClass SmallFrame'
poolDictionaries: ''
category: 'Kernel-Methods'!
+ !CompiledMethod commentStamp: 'eem 8/12/2014 14:45' prior: 0!
+ CompiledMethod instances are methods suitable for interpretation by the virtual machine. Instances of CompiledMethod and its subclasses are the only objects in the system that have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. CompiledMethod inherits from ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray.
- !CompiledMethod commentStamp: 'eem 5/12/2014 18:02' prior: 0!
- My instances are methods suitable for interpretation by the virtual machine. This is the only class in the system whose instances have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. I'm a subclass of ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray.
Class variables:
SmallFrame - the number of stack slots in a small frame Context
LargeFrame - the number of stack slots in a large frame Context
PrimaryBytecodeSetEncoderClass - the encoder class that defines the primary instruction set
SecondaryBytecodeSetEncoderClass - the encoder class that defines the secondary instruction set
The current format of a CompiledMethod is as follows:
header (4 or 8 bytes, SmallInteger)
+ literals (4 or 8 bytes each, Object, see "The last literal..." below)
- literals (4 or 8 bytes each, Object)
bytecodes (variable, bytes)
trailer (variable, bytes)
+ The header is a 31-bit signed integer (a SmallInteger) in the following format:
- The header is a 31-bit signed integer (a SmallInteger) with one of the two following formats, selected by the sign bit:
- sign bit 0, header >= 0:
- (index 0) 9 bits: main part of primitive number (#primitive)
- (index 9) 8 bits: number of literals (#numLiterals)
- (index 17) 1 bit: whether a large frame size is needed (#frameSize)
- (index 18) 6 bits: number of temporary variables (#numTemps)
- (index 24) 4 bits: number of arguments to the method (#numArgs)
- (index 28) 1 bit: high-bit of primitive number (#primitive)
- (index 29) 1 bit: flag bit, ignored by the VM (#flag)
- (index 30/63) sign bit: 0 selects the Primary instruction set (#signFlag)
- sign bit 1, header < 0:
(index 0) 16 bits: number of literals (#numLiterals)
(index 16) 1 bit: has primitive
+ (index 17) 1 bit: whether a large frame size is needed (#frameSize => either SmallFrame or LargeFrame)
- (index 17) 1 bit: whether a large frame size is needed (#frameSize)
(index 18) 6 bits: number of temporary variables (#numTemps)
(index 24) 4 bits: number of arguments to the method (#numArgs)
+ (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public), although accessors for bit 29 exist (see #flag).
+ (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4, 0 selects the primary instruction set, e.g. SqueakV3PlusClosures) (#signFlag)
- (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public)
- (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4) (#signFlag)
- i.e. the Secondary Bytecode Set expands the number of literals to 65535 by assuming a CallPrimitive bytecode.
+ If the method has a primitive then the first bytecode of the method must be a callPrimitive: bytecode that encodes the primitive index.
+
+ The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.
+
+ The last literal in a CompiledMethod must be its methodClassAssociation, a binding whose value is the class the method is installed in. The methodClassAssociation is used to implement super sends. If a method contains no super send then its methodClassAssociation may be left nil (as would be the case for example of methods providing a pool of inst var accessors). By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState. AdditionalMethodState holds any pragmas and properties of a method, but may also be used to add instance variables to a method, albeit ones held in the method's AdditionalMethodState. Subclasses of CompiledMethod that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledMethod subclass to answer the specialized subclass of AdditionalMethodState.!
- The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.!
Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 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."
+ | method pc |
+ nArgs > 15 ifTrue:
+ [^self error: 'Cannot compile -- too many arguments'].
- | largeBit primBits |
nTemps > 63 ifTrue:
+ [^self error: 'Cannot compile -- too many temporary variables'].
+ nLits > 65535 ifTrue:
+ [^self error: 'Cannot compile -- too many literals'].
- [^ self error: 'Cannot compile -- too many temporary variables'].
- nLits > 255 ifTrue:
- [^ self error: 'Cannot compile -- too many literals'].
- 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)].
+ 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!
- ^trailer
- createMethod: numberOfBytes
- class: self
- header: (nArgs bitShift: 24) +
- (nTemps bitShift: 18) +
- (largeBit bitShift: 17) +
- (nLits bitShift: 9) +
- 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."
+ | method pc |
+ nArgs > 15 ifTrue:
+ [^self error: 'Cannot compile -- too many arguments'].
- | largeBit primBits flagBit |
nTemps > 63 ifTrue:
+ [^self error: 'Cannot compile -- too many temporary variables'].
+ nLits > 65535 ifTrue:
+ [^self error: 'Cannot compile -- too many literals'].
- [^ self error: 'Cannot compile -- too many temporary variables'].
- nLits > 255 ifTrue:
- [^ self error: 'Cannot compile -- too many literals'].
- largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0].
+ 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!
- "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 ].
-
- ^trailer
- createMethod: numberOfBytes
- class: self
- header: (nArgs bitShift: 24) +
- (nTemps bitShift: 18) +
- (largeBit bitShift: 17) +
- (nLits bitShift: 9) +
- primBits +
- (flagBit bitShift: 29)!
Item was changed:
----- Method: CompiledMethod class>>newMethod:header: (in category 'instance creation') -----
+ newMethod: numberOfBytes header: headerWord
- 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."
- information) is specified the headerWord. 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. Once
- the header of a method is set by this primitive, it cannot be changed in
- any way. Essential. See Object documentation whatIsAPrimitive."
+ <primitive: 79 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingNewMethod: numberOfBytes header: headerWord].
- <primitive: 79>
- (numberOfBytes isInteger and:
- [headerWord isInteger and:
- [numberOfBytes >= 0]]) ifTrue: [
- "args okay; space must be low"
- OutOfMemory signal.
- "retry if user proceeds"
- ^ self newMethod: numberOfBytes header: headerWord
- ].
^self primitiveFailed!
Item was changed:
----- Method: CompiledMethod class>>toReturnConstant:trailerBytes: (in category 'instance creation') -----
toReturnConstant: index trailerBytes: trailer
"Answer an instance of me that is a quick return of the constant
indexed in (true false nil -1 0 1 2)."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index
- !
Item was changed:
----- Method: CompiledMethod class>>toReturnField:trailerBytes: (in category 'instance creation') -----
toReturnField: field trailerBytes: trailer
"Answer an instance of me that is a quick return of the instance variable
indexed by the argument, field."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field
- !
Item was changed:
----- Method: CompiledMethod class>>toReturnSelfTrailerBytes: (in category 'instance creation') -----
toReturnSelfTrailerBytes: trailer
"Answer an instance of me that is a quick return of the instance (^self)."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256
- !
Item was added:
+ ----- Method: CompiledMethod>>bytecodeSetName (in category 'accessing') -----
+ bytecodeSetName
+ ^self encoderClass name copyReplaceAll: 'EncoderFor' with: ''!
Item was changed:
----- Method: CompiledMethod>>headerDescription (in category 'literals') -----
headerDescription
+ "Answer a description containing the information about the form of the
+ receiver and the form of the context needed to run the receiver."
- "Answer a description containing the information about the form of the
- receiver and the form of the context needed to run the receiver."
+ ^(ByteString new: 128) writeStream
+ print: self header; cr;
+ nextPutAll: '"primitive: '; print: self primitive; cr;
+ nextPutAll: ' numArgs: '; print: self numArgs; cr;
+ nextPutAll: ' numTemps: '; print: self numTemps; cr;
+ nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
+ nextPutAll: ' frameSize: '; print: self frameSize; cr;
+ nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
+ nextPut: $"; cr;
+ contents!
- | s |
- s := '' writeStream.
- self header printOn: s.
- s cr; nextPutAll: '"primitive: '.
- self primitive printOn: s.
- s cr; nextPutAll: ' numArgs: '.
- self numArgs printOn: s.
- s cr; nextPutAll: ' numTemps: '.
- self numTemps printOn: s.
- s cr; nextPutAll: ' numLiterals: '.
- self numLiterals printOn: s.
- s cr; nextPutAll: ' frameSize: '.
- self frameSize printOn: s.
- s cr; nextPutAll: ' isClosureCompiled: '.
- self isBlueBookCompiled not printOn: s.
- s nextPut: $"; cr.
- ^ s contents!
Item was changed:
----- Method: CompiledMethod>>numLiterals (in category 'accessing') -----
numLiterals
"Answer the number of literals used by the receiver."
+ ^self header bitAnd: 65535!
- | header |
- ^(header := self header) < 0
- ifTrue: [header bitAnd: 65535]
- ifFalse: [(header bitShift: -9) bitAnd: 16rFF]!
Item was changed:
----- Method: CompiledMethod>>primitive (in category 'accessing') -----
primitive
"Answer the primitive index associated with the receiver.
+ Zero indicates that this is not a primitive method."
+ | initialPC |
+ ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
+ ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
+ ifFalse: [0]!
- Zero indicates that this is not a primitive method.
- In the original header format we currently allow 10 bits of primitive index, but they are
- in two places for backward compatibility. In the new format the primitive index is in the
- last two bytes of a three byte callPrimitive: bytecode. The time to unpack is negligible,
- since the derived primitive function pointer full index is stored in the method cache."
- | header initialPC |
- ^(header := self header) < 0
- ifTrue:
- [(header anyMask: 65536) "Is the hasPrimitive? flag set?"
- ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
- ifFalse: [0]]
- ifFalse:
- [(header bitAnd: 16r1FF) + ((header bitShift: -19) bitAnd: 16r200)]!
Item was changed:
----- Method: ContextPart>>activateReturn:value: (in category 'private') -----
activateReturn: aContext value: value
"Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
+ ^MethodContext
+ sender: self
- ^ self
- activateMethod: ContextPart theReturnMethod
- withArgs: {value}
receiver: aContext
+ method: MethodContext theReturnMethod
+ arguments: {value}!
- class: aContext class!
Item was changed:
----- Method: ContextPart>>doPrimitive:method:receiver:args: (in category 'private') -----
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
+ "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and
+ arguments are given as arguments to this message. If successful, push result and return
+ resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
+ execution needs to be intercepted and simulated to avoid execution running away."
- "Simulate a primitive method whose index is primitiveIndex. The
- simulated receiver and arguments are given as arguments to this message.
- If successful, push result and return resuming context, else ^ PrimitiveFailToken.
- Any primitive which provokes execution needs to be intercepted and simulated
- to avoid execution running away."
| value |
"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
the debugger from entering various run-away activities such as spawning a new
process, etc. Injudicious use results in the debugger not being able to debug
+ interesting code, such as the debugger itself. hence use primitive 19 with care :-)"
- interesting code, such as the debugger itself. hence use primtiive 19 with care :-)"
"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
primitiveIndex = 19 ifTrue:
[ToolSet
debugContext: self
label:'Code simulation error'
contents: nil].
+ ((primitiveIndex between: 201 and: 222)
+ and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
+ [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
+ or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
+ [^receiver simulateValueWithArguments: arguments caller: self].
+ primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
+ [^receiver simulateValueWithArguments: arguments first caller: self]].
- "ContextPart>>blockCopy:; simulated to get startpc right"
- (primitiveIndex = 80 and: [(self objectClass: receiver) includesBehavior: ContextPart])
- ifTrue: [^self push: ((BlockContext newForMethod: receiver method)
- home: receiver home
- startpc: pc + 2
- nargs: (arguments at: 1))].
- (primitiveIndex = 81 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>value[:value:...]"
- ifTrue: [^receiver pushArgs: arguments from: self].
- (primitiveIndex = 82 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>valueWithArguments:"
- ifTrue: [^receiver pushArgs: arguments first from: self].
- primitiveIndex = 83 "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
- ifTrue: [^self send: arguments first
- to: receiver
- with: arguments allButFirst
- super: false].
- primitiveIndex = 84 "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
- ifTrue: [^self send: arguments first
- to: receiver
- with: (arguments at: 2)
- startClass: nil].
- primitiveIndex = 100 "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
- ifTrue: [^self send: arguments first
- to: receiver
- with: (arguments at: 2)
- startClass: (arguments at: 3)].
+ primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
+ [^self send: arguments first to: receiver with: arguments allButFirst super: false].
+ primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
+ [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
+ primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
+ [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
+
"Mutex>>primitiveEnterCriticalSection
Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
[| active effective |
active := Processor activeProcess.
effective := active effectiveProcess.
"active == effective"
value := primitiveIndex = 186
ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
+ ^(self isPrimFailToken: value)
- ^((self objectClass: value) == Array
- and: [value size = 2
- and: [value first == PrimitiveFailToken]])
ifTrue: [value]
ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
[^MethodContext
sender: self
receiver: receiver
method: (arguments at: 2)
arguments: (arguments at: 1)].
"Closure primitives"
(primitiveIndex = 200 and: [self == receiver]) ifTrue:
"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
[^self push: (BlockClosure
outerContext: receiver
startpc: pc + 2
numArgs: arguments first
copiedValues: arguments last)].
- ((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
- or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
- [^receiver simulateValueWithArguments: arguments caller: self].
- primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
- [^receiver simulateValueWithArguments: arguments first caller: self].
primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
[(arguments size = 2
and: [arguments first isInteger
and: [(self objectClass: arguments last) == Array]]) ifFalse:
[^ContextPart primitiveFailTokenFor: nil].
^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method"
ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
ifFalse:
[primitiveIndex = 117 "named primitives"
ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
+ ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
+
+ ^(self isPrimFailToken: value)
- ifFalse:
- [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
- ^((self objectClass: value) == Array
- and: [value size = 2
- and: [value first == PrimitiveFailToken]])
ifTrue: [value]
ifFalse: [self push: value]!
Item was added:
+ ----- Method: ContextPart>>isPrimFailToken: (in category 'private') -----
+ isPrimFailToken: anObject
+ ^(self objectClass: anObject) == Array
+ and: [anObject size = 2
+ and: [anObject first == PrimitiveFailToken]]!
Item was added:
+ ----- Method: ContextPart>>send:to:with:lookupIn: (in category 'controlling') -----
+ send: selector to: rcvr with: arguments lookupIn: lookupClass
+ "Simulate the action of sending a message with selector and arguments
+ to rcvr. The argument, lookupClass, is the class in which to lookup the
+ message. This is the receiver's class for normal messages, but for super
+ messages it will be some specific class related to the source method."
+
+ | meth primIndex val ctxt |
+ (meth := lookupClass lookupSelector: selector) ifNil:
+ [^self send: #doesNotUnderstand:
+ to: rcvr
+ with: {Message selector: selector arguments: arguments}
+ lookupIn: lookupClass].
+ (primIndex := meth primitive) > 0 ifTrue:
+ [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
+ (self isPrimFailToken: val) ifFalse:
+ [^val]].
+ (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
+ [^self error: 'Simulated message ', arguments first selector, ' not understood'].
+ ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
+ primIndex > 0 ifTrue:
+ [ctxt failPrimitiveWith: val].
+ ^ctxt!
Item was changed:
----- Method: ContextPart>>send:to:with:super: (in category 'controlling') -----
+ send: selector to: rcvr with: arguments super: superFlag
+ "Simulate the action of sending a message with selector arguments
+ to rcvr. The argument, superFlag, tells whether the receiver of the
+ message was specified with 'super' in the source method."
- send: selector to: rcvr with: args super: superFlag
- "Simulate the action of sending a message with selector, selector, and
- arguments, args, to receiver. The argument, superFlag, tells whether the
- receiver of the message was specified with 'super' in the source method."
+ ^self send: selector
+ to: rcvr
+ with: arguments
+ lookupIn: (superFlag
+ ifTrue: [self method methodClassAssociation value superclass]
+ ifFalse: [self objectClass: rcvr])!
- | class meth val ctxt |
- class := superFlag
- ifTrue: [self method methodClassAssociation value superclass]
- ifFalse: [self objectClass: rcvr].
- meth := class lookupSelector: selector.
- meth == nil ifTrue:
- [^self
- send: #doesNotUnderstand:
- to: rcvr
- with: (Array with: (Message selector: selector arguments: args))
- super: superFlag].
- val := self tryPrimitiveFor: meth receiver: rcvr args: args.
- ((self objectClass: val) == Array
- and: [val size = 2
- and: [val first == PrimitiveFailToken]]) ifFalse:
- [^val].
- (selector == #doesNotUnderstand:
- and: [class == ProtoObject]) ifTrue:
- [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood'].
- ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class.
- ((self objectClass: val) == Array
- and: [val size = 2
- and: [val first == PrimitiveFailToken
- and: [val last notNil
- and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue:
- [ctxt at: ctxt stackPtr put: val last].
- ^ctxt!
Item was changed:
----- Method: ContextPart>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') -----
tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
+ "Invoke the named primitive for aCompiledMethod, answering its result, or,
+ if the primiitve fails, answering the error code."
- | selector theMethod spec receiverClass |
<primitive: 218 error: ec>
ec ifNotNil:
["If ec is an integer other than -1 there was a problem with primitive 218,
not with the external primitive itself. -1 indicates a generic failure (where
ec should be nil) but ec = nil means primitive 218 is not implemented. So
interpret -1 to mean the external primitive failed with a nil error code."
ec isInteger ifTrue:
[ec = -1
ifTrue: [ec := nil]
+ ifFalse: [self primitiveFailed]]].
+ ^self class primitiveFailTokenFor: ec!
- ifFalse: [self primitiveFailed]].
- ^{PrimitiveFailToken. ec}].
- "Assume a nil error code implies the primitive is not implemented and fall back on the old code."
- "Hack. Attempt to execute the named primitive from the given compiled method"
- arguments size > 8 ifTrue:
- [^{PrimitiveFailToken. nil}].
- selector := #(
- tryNamedPrimitive
- tryNamedPrimitive:
- tryNamedPrimitive:with:
- tryNamedPrimitive:with:with:
- tryNamedPrimitive:with:with:with:
- tryNamedPrimitive:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:with:with:) at: arguments size+1.
- receiverClass := self objectClass: aReceiver.
- theMethod := receiverClass lookupSelector: selector.
- theMethod == nil ifTrue:
- [^{PrimitiveFailToken. nil}].
- spec := theMethod literalAt: 1.
- spec replaceFrom: 1 to: spec size with: (aCompiledMethod literalAt: 1) startingAt: 1.
- Smalltalk unbindExternalPrimitives.
- ^self object: aReceiver perform: selector withArguments: arguments inClass: receiverClass!
Item was added:
+ ----- Method: InstructionClient>>callPrimitive: (in category 'instruction decoding') -----
+ callPrimitive: pimIndex
+ "V3PlusClosures: 139 10001011 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ NewsqueakV4: 249 11111001 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + ( jjjjjjj * 256)
+ m=1 means inlined primitive, no hard return after execution."!
Item was added:
+ ----- Method: InstructionPrinter>>callPrimitive: (in category 'instruction decoding') -----
+ callPrimitive: index
+ "Print the callPrimitive."
+
+ self print: 'callPrimtive: ' , index printString!
Item was changed:
----- Method: InstructionStream>>interpretV3ClosuresExtension:in:for: (in category 'decoding - private - v3 plus closures') -----
interpretV3ClosuresExtension: offset in: method for: client
| type offset2 byte2 byte3 byte4 |
offset <= 6 ifTrue:
["Extended op codes 128-134"
byte2 := method at: pc. pc := pc + 1.
offset <= 2 ifTrue:
["128-130: extended pushes and pops"
type := byte2 // 64.
offset2 := byte2 \\ 64.
offset = 0 ifTrue:
[type = 0 ifTrue: [^client pushReceiverVariable: offset2].
type = 1 ifTrue: [^client pushTemporaryVariable: offset2].
type = 2 ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)].
type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]].
offset = 1 ifTrue:
[type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2].
type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2].
type = 2 ifTrue: [self error: 'illegalStore'].
type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
offset = 2 ifTrue:
[type = 0 ifTrue: [^client popIntoReceiverVariable: offset2].
type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2].
type = 2 ifTrue: [self error: 'illegalStore'].
type = 3 ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
"131-134: extended sends"
offset = 3 ifTrue: "Single extended send"
[^client send: (method literalAt: byte2 \\ 32 + 1)
super: false numArgs: byte2 // 32].
offset = 4 ifTrue: "Double extended do-anything"
[byte3 := method at: pc. pc := pc + 1.
type := byte2 // 32.
type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1)
super: false numArgs: byte2 \\ 32].
type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1)
super: true numArgs: byte2 \\ 32].
type = 2 ifTrue: [^client pushReceiverVariable: byte3].
type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)].
type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)].
type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3].
type = 6 ifTrue: [^client popIntoReceiverVariable: byte3].
type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
offset = 5 ifTrue: "Single extended send to super"
[^client send: (method literalAt: byte2 \\ 32 + 1)
super: true
numArgs: byte2 // 32].
offset = 6 ifTrue: "Second extended send"
[^client send: (method literalAt: byte2 \\ 64 + 1)
super: false
numArgs: byte2 // 64]].
offset = 7 ifTrue: [^client doPop].
offset = 8 ifTrue: [^client doDup].
offset = 9 ifTrue: [^client pushActiveContext].
byte2 := method at: pc. pc := pc + 1.
offset = 10 ifTrue:
[^byte2 < 128
ifTrue: [client pushNewArrayOfSize: byte2]
ifFalse: [client pushConsArrayWithElements: byte2 - 128]].
- offset = 11 ifTrue: [^self error: 'unusedBytecode'].
byte3 := method at: pc. pc := pc + 1.
+ offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)].
offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3].
offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
"offset = 15"
byte4 := method at: pc. pc := pc + 1.
^client
pushClosureCopyNumCopiedValues: (byte2 bitShift: -4)
numArgs: (byte2 bitAnd: 16rF)
blockSize: (byte3 * 256) + byte4!
Item was changed:
----- Method: Integer class>>initialize (in category 'class initialization') -----
+ initialize
+ "Integer initialize"
+ self initializeLowBitPerByteTable!
- initialize "Integer initialize"
- "Ensure we have the right compact class index"
-
- "LPI has been a compact class forever - just ensure basic correctness"
- (LargePositiveInteger indexIfCompact = 5) ifFalse:[
- (Smalltalk compactClassesArray at: 5)
- ifNil:[LargePositiveInteger becomeCompactSimplyAt: 5]
- ifNotNil:[self error: 'Unexpected compact class setup']].
-
- "Cog requires LNI to be compact at 4 (replacing PseudoContext)"
- (LargeNegativeInteger indexIfCompact = 4) ifFalse:[
- "PseudoContext will likely get removed at some point so write this test
- without introducing a hard dependency"
- (Smalltalk compactClassesArray at: 4) name == #PseudoContext
- ifTrue:[Smalltalk compactClassesArray at: 4 put: nil].
- (Smalltalk compactClassesArray at: 4)
- ifNil:[LargeNegativeInteger becomeCompactSimplyAt: 4]
- ifNotNil:[self error: 'Unexpected compact class setup']].
-
- self initializeLowBitPerByteTable
- !
Item was added:
+ ----- Method: MethodContext class>>allInstances (in category 'enumerating') -----
+ allInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since this context has been created only to
+ compute the existing instances."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ insts nextPut: inst.
+ inst := next].
+ ^insts contents!
Item was changed:
----- Method: MethodContext class>>allInstancesDo: (in category 'private') -----
allInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since evaluation of aBlock will create new contexts."
- "Only count until thisContext since evaluation of aBlock will create new contexts."
- | inst next |
inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
- [inst == thisContext] whileFalse:[
- next := inst nextInstance.
- aBlock value: inst.
- inst := next]
- !
Item was added:
+ ----- Method: MethodContext>>failPrimitiveWith: (in category 'system simulation') -----
+ failPrimitiveWith: maybePrimFailToken
+ "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive:
+ bytecode and store the primitive fail code if there is one and the method consumes it."
+ self skipCallPrimitive.
+ ((self isPrimFailToken: maybePrimFailToken)
+ and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
+ [self at: stackp put: maybePrimFailToken last]!
Item was changed:
----- Method: ProtoObject>>scaledIdentityHash (in category 'comparing') -----
scaledIdentityHash
"For identityHash values returned by primitive 75, answer
+ such values times 2^8. Otherwise, match the existing
+ identityHash implementation"
- such values times 2^18. Otherwise, match the existing
- identityHash implementation"
+ ^self identityHash * 256 "bitShift: 8"!
- ^self identityHash * 262144 "bitShift: 18"!
Item was changed:
==== ERROR ===
Error: Unrecognized class type
27 September 2014 8:29:49.152 pm
VM: unix - a SmalltalkImage
Image: Squeak3.11alpha [latest update: #8824]
SecurityManager state:
Restricted: false
FileAccess: true
SocketAccess: true
Working Dir /home/squeaksource
Trusted Dir /home/squeaksource/secure
Untrusted Dir /home/squeaksource/My Squeak
MCClassDefinition(Object)>>error:
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
aString: 'Unrecognized class type'
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
MCClassDefinition>>kindOfSubclass
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
MCClassDefinition>>printDefinitionOn:
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
stream: a WriteStream
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
[] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
Receiver: a MCDiffyTextWriter
Arguments and temporary variables:
definition: a WriteStream
s: a MCClassDefinition(SmallInteger)
Receiver's instance variables:
stream: a WriteStream
initStream: nil
--- The full stack ---
MCClassDefinition(Object)>>error:
MCClassDefinition>>kindOfSubclass
MCClassDefinition>>printDefinitionOn:
[] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
String class(SequenceableCollection class)>>new:streamContents:
String class(SequenceableCollection class)>>streamContents:
MCDiffyTextWriter(MCTextWriter)>>chunkContents:
MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
MCDiffyTextWriter(MCStWriter)>>visitClassDefinition:
MCClassDefinition>>accept:
[] in MCDiffyTextWriter(MCTextWriter)>>visitInFork:
String class(SequenceableCollection class)>>new:streamContents:
String class(SequenceableCollection class)>>streamContents:
MCDiffyTextWriter(MCTextWriter)>>visitInFork:
MCDiffyTextWriter>>writePatchFrom:to:
MCDiffyTextWriter>>writeModification:
[] in MCDiffyTextWriter>>writePatch:
SortedCollection(OrderedCollection)>>do:
MCDiffyTextWriter>>writePatch:
SSDiffyTextWriter>>writePatch:
[] in SSDiffyTextWriter>>writeVersion:for:
BlockClosure>>on:do:
SSDiffyTextWriter>>writeVersion:for:
[] in SSEMailSubscription>>versionAdded:to:
BlockClosure>>on:do:
SSEMailSubscription>>versionAdded:to:
[] in [] in SSProject>>versionAdded:
[] in BlockClosure>>newProcess
1
0
Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel.spur-ul.874.mcz
==================== Summary ====================
Name: Kernel.spur-ul.874
Author: eem
Time: 27 September 2014, 1:16:58.068 pm
UUID: 85920b38-0a4d-48b3-b101-2b4fcc7b88a5
Ancestors: Kernel-ul.874
Kernel-ul.874 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.208
Random changes:
- fixed off-by-one error in #next
- seed is always a Float
- added #hashSeed: which can be used to produce a better initial seed. Small seeds will result in less random first value.
- seed is forced between 0 and 2^31-1 if it's out of range using #hashSeed:
- simplified #initialize. 0 is not a bad seed value
- fixed #nextValue's comment and simplified the implementation a bit
- added clarification to #nextInt:'s comment
- sped up #bucketTest: on the class side
=============== Diff against Kernel-ul.874 ===============
Item was changed:
----- Method: Behavior>>allInstances (in category 'accessing instances and variables') -----
+ allInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == nil] whileFalse:
+ [next := inst nextInstance.
+ (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
+ inst := next].
+ ^insts contents!
- allInstances
- "Answer a collection of all current instances of the receiver."
-
- | all |
- all := OrderedCollection new.
- self allInstancesDo: [:x | x == all ifFalse: [all add: x]].
- ^ all asArray
- !
Item was changed:
----- Method: Behavior>>allInstancesDo: (in category 'enumerating') -----
+ allInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst."
- allInstancesDo: aBlock
- "Evaluate the argument, aBlock, for each of the current instances of the
- receiver.
-
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst."
- | inst next |
inst := self someInstance.
+ [inst == nil] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
- [inst == nil]
- whileFalse:
- [
- next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was added:
+ ----- Method: Behavior>>allInstancesOrNil (in category 'enumerating') -----
+ allInstancesOrNil
+ "Answer all instances of the receiver, or nil if the primitive
+ fails, which it may be due to being out of memory."
+ <primitive: 177>
+ ^nil!
Item was changed:
----- Method: Behavior>>basicNew (in category 'instance creation') -----
basicNew
"Primitive. Answer an instance of the receiver (which is a class) with no
+ indexable variables. Fail if the class is indexable. Essential. See Object
+ documentation whatIsAPrimitive.
+
+ If the primitive fails because space is low then the scavenger will run
+ before the method is activated. Check that space was low and retry
+ via handleFailingBasicNew if so."
- indexable variables. Fail if the class is indexable. Essential. See Object
- documentation whatIsAPrimitive."
+ <primitive: 70 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingBasicNew].
+ self isVariable ifTrue: [^self basicNew: 0].
+ self primitiveFailed!
- <primitive: 70>
- self isVariable ifTrue: [ ^ self basicNew: 0 ].
- "space must be low"
- OutOfMemory signal.
- ^ self basicNew "retry if user proceeds"
- !
Item was changed:
----- Method: Behavior>>basicNew: (in category 'instance creation') -----
+ basicNew: sizeRequested
+ "Primitive. Answer an instance of this class with the number of indexable
+ variables specified by the argument, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive.
+
+ If the primitive fails because space is low then the scavenger will run before the
+ method is activated. Check args and retry via handleFailingBasicNew: if they're OK."
- basicNew: sizeRequested
- "Primitive. Answer an instance of this class with the number
- of indexable variables specified by the argument, sizeRequested.
- Fail if this class is not indexable or if the argument is not a
- positive Integer, or if there is not enough memory available.
- Essential. See Object documentation whatIsAPrimitive."
+ <primitive: 71 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingBasicNew: sizeRequested].
- <primitive: 71>
self isVariable ifFalse:
[self error: self printString, ' cannot have variable sized instances'].
- (sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue:
- ["arg okay; space must be low."
- OutOfMemory signal.
- ^ self basicNew: sizeRequested "retry if user proceeds"].
self primitiveFailed!
Item was added:
+ ----- Method: Behavior>>byteSizeOfInstance (in category 'accessing instances and variables') -----
+ byteSizeOfInstance
+ "Answer the total memory size of an instance of the receiver."
+
+ <primitive: 181 error: ec>
+ self isVariable ifTrue:
+ [^self byteSizeOfInstanceOfSize: 0].
+ self primitiveFailed!
Item was added:
+ ----- Method: Behavior>>byteSizeOfInstanceOfSize: (in category 'accessing instances and variables') -----
+ byteSizeOfInstanceOfSize: basicSize
+ "Answer the total memory size of an instance of the receiver
+ with the given number of indexable instance variables."
+
+ <primitive: 181 error: ec>
+ self isVariable
+ ifTrue: "If the primitive overflowed answer a close approximation"
+ [(basicSize isInteger
+ and: [basicSize >= 16r1000000]) ifTrue:
+ [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
+ - (self byteSizeOfInstanceOfSize: 0)]]
+ ifFalse:
+ [basicSize = 0 ifTrue:
+ [^self byteSizeOfInstance]].
+ self primitiveFailed!
Item was added:
+ ----- 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 (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 added:
+ ----- Method: Behavior>>handleFailingBasicNew (in category 'private') -----
+ handleFailingBasicNew
+ "handleFailingBasicNew gets sent after basicNew 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 70>
+ Smalltalk garbageCollect < 1048576 ifTrue:
+ [Smalltalk growMemoryByAtLeast: 1048576].
+ ^self handleFailingFailingBasicNew "retry after global garbage collect"!
Item was added:
+ ----- Method: Behavior>>handleFailingBasicNew: (in category 'private') -----
+ handleFailingBasicNew: sizeRequested
+ "handleFailingBasicNew: gets sent after basicNew: 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 71>
+ | bytesRequested |
+ bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
+ Smalltalk garbageCollect < bytesRequested ifTrue:
+ [Smalltalk growMemoryByAtLeast: bytesRequested].
+ "retry after global garbage collect and possible grow"
+ ^self handleFailingFailingBasicNew: sizeRequested!
Item was added:
+ ----- Method: Behavior>>handleFailingFailingBasicNew (in category 'private') -----
+ handleFailingFailingBasicNew
+ "This basicNew 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 70>
+ "space must be low"
+ OutOfMemory signal.
+ ^self basicNew "retry if user proceeds"!
Item was added:
+ ----- Method: Behavior>>handleFailingFailingBasicNew: (in category 'private') -----
+ handleFailingFailingBasicNew: sizeRequested
+ "This basicNew: 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, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 71>
+ "space must be low."
+ OutOfMemory signal.
+ ^self basicNew: sizeRequested "retry if user proceeds"!
Item was added:
+ ----- Method: Behavior>>identityHash (in category 'comparing') -----
+ identityHash
+ "Answer a SmallInteger whose value is related to the receiver's identity.
+ Behavior implements identityHash to allow the VM to use an object representation which
+ does not include a direct reference to an object's class in an object. If the VM is using
+ this implementation then classes are held in a class table and instances contain the index
+ of their class in the table. A class's class table index is its identityHash so that an instance
+ can be created without searching the table for a class's index. The VM uses this primitive
+ to enter the class into the class table, assigning its identityHash with an as yet unused
+ class table index. If this primitive fails it means that the class table is full. In Spur as of
+ 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
+
+ Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
+
+ <primitive: 175>
+ self primitiveFailed!
Item was changed:
----- Method: Behavior>>indexIfCompact (in category 'private') -----
indexIfCompact
+ "Backward compatibility with the Squeak V3 object format.
+ Spur does not have a distinction between compact and non-compact classes."
+ ^0!
- "If these 5 bits are non-zero, then instances of this class
- will be compact. It is crucial that there be an entry in
- Smalltalk compactClassesArray for any class so optimized.
- See the msgs becomeCompact and becomeUncompact."
- ^ (format bitShift: -11) bitAnd: 16r1F
- "
- Smalltalk compactClassesArray doWithIndex:
- [:c :i | c == nil ifFalse:
- [c indexIfCompact = i ifFalse: [self halt]]]
- "!
Item was changed:
----- Method: Behavior>>instSize (in category 'testing') -----
instSize
"Answer the number of named instance variables
+ (as opposed to indexed variables) of the receiver.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>"
+ ^format bitAnd: 16rFFFF!
- (as opposed to indexed variables) of the receiver."
-
- self flag: #instSizeChange. "Smalltalk browseAllCallsOn: #instSizeChange"
- "
- NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
- When we revise the image format, it should become...
- ^ ((format bitShift: -1) bitAnd: 16rFF) - 1
- Note also that every other method in this category will require
- 2 bits more of right shift after the change.
- "
- ^ ((format bitShift: -10) bitAnd: 16rC0) + ((format bitShift: -1) bitAnd: 16r3F) - 1!
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 (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)"
+ ^(format bitShift: -16) bitAnd: 16r1F!
- ^ (format bitShift: -7) bitAnd: 16rF!
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 (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!
- "Answer whether the receiver contains just bits (not pointers)."
-
- ^ self instSpec >= 6!
Item was changed:
----- Method: Behavior>>isBytes (in category 'testing') -----
isBytes
+ "Answer whether the receiver has 8-bit 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 (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!
- "Answer whether the receiver has 8-bit instance variables."
-
- ^ self instSpec >= 8!
Item was added:
+ ----- Method: Behavior>>isEphemeronClass (in category 'testing') -----
+ isEphemeronClass
+ "Answer whether the receiver has ephemeral instance variables. The garbage collector will
+ fire (queue for finalization) any ephemeron whose first instance variable is not referenced
+ other than from the transitive closure of references from ephemerons. Hence referring to
+ an object from the first inst var of an ephemeron will cause the ephemeron to fire when
+ the rest of the system does not refer to the object and that object is ready to be collected.
+ Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
+ from firing, ephemerons may act as the associations in weak dictionaries such that the value
+ (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
+ other than from ephemerons. Ephemerons can therefore be used to implement instance-based
+ pre-mortem finalization."
+ ^self instSpec = 5!
Item was added:
+ ----- Method: Behavior>>isImmediateClass (in category 'testing') -----
+ isImmediateClass
+ "Answer whether the receiver has immediate instances. Immediate instances
+ store their value in their object pointer, not in an object body. Hence immediates
+ take no space and are immutable. The immediates are distinguished by tag bits
+ in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit
+ system SmallIntegers are 31-bit signed integers and Characters are 30-bit
+ unsigned character codes."
+ ^self instSpec = 7!
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 (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]]!
- "Answer whether the receiver has indexable variables."
-
- ^ self instSpec >= 2!
Item was changed:
----- Method: Behavior>>kindOfSubclass (in category 'testing class hierarchy') -----
kindOfSubclass
+ "Answer a String that is the keyword that describes the receiver's kind of subclass,
+ either a regular subclass, a variableSubclass, a variableByteSubclass,
+ a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
+ c.f. typeOfClass"
+ ^self isVariable
+ ifTrue:
+ [self isBits
+ ifTrue:
+ [self isBytes
+ ifTrue: [' variableByteSubclass: ']
+ ifFalse: [' variableWordSubclass: ']]
+ ifFalse:
+ [self isWeak
+ ifTrue: [' weakSubclass: ']
+ ifFalse: [' variableSubclass: ']]]
+ ifFalse:
+ [self isImmediateClass
+ ifTrue: [' immediateSubclass: ']
+ ifFalse:
+ [self isEphemeronClass
+ ifTrue: [' ephemeronSubclass: ']
+ ifFalse: [' subclass: ']]]!
- "Answer a String that is the keyword that describes the receiver's kind
- of subclass, either a regular subclass, a variableSubclass, a
- variableByteSubclass, a variableWordSubclass, or a weakSubclass."
- self isWeak
- ifTrue: [^ ' weakSubclass: '].
- ^ self isVariable
- ifTrue: [self isBits
- ifTrue: [self isBytes
- ifTrue: [ ' variableByteSubclass: ']
- ifFalse: [ ' variableWordSubclass: ']]
- ifFalse: [ ' variableSubclass: ']]
- ifFalse: [ ' subclass: ']!
Item was changed:
----- Method: Behavior>>shouldNotBeRedefined (in category 'testing') -----
shouldNotBeRedefined
+ "Answer if the receiver should not be redefined.
+ The assumption is that classes in Smalltalk specialObjects and
+ instance-specific Behaviors should not be redefined"
- "Return true if the receiver should not be redefined.
- The assumption is that compact classes,
- classes in Smalltalk specialObjects and
- Behaviors should not be redefined"
+ ^(Smalltalk specialObjectsArray
+ identityIndexOf: self
+ ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!
- ^(Smalltalk compactClassesArray includes: self)
- or:[(Smalltalk specialObjectsArray includes: self)
- or:[self isKindOf: self]]!
Item was changed:
----- Method: Behavior>>typeOfClass (in category 'accessing') -----
typeOfClass
+ "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass"
+ self isBytes ifTrue:
+ [^self instSpec = CompiledMethod instSpec
+ ifTrue: [#compiledMethod] "Very special!!"
+ ifFalse: [#bytes]].
+ (self isWords and: [self isPointers not]) ifTrue:
+ [^self instSpec = SmallInteger instSpec
+ ifTrue: [#immediate] "Very special!!"
+ ifFalse: [#words]].
+ self isWeak ifTrue: [^#weak].
+ self isVariable ifTrue: [^#variable].
+ self isEphemeronClass ifTrue: [^#ephemeron].
+ ^#normal!
- "Answer a symbol uniquely describing the type of the receiver"
- self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!"
- self isBytes ifTrue:[^#bytes].
- (self isWords and:[self isPointers not]) ifTrue:[^#words].
- self isWeak ifTrue:[^#weak].
- self isVariable ifTrue:[^#variable].
- ^#normal.!
Item was changed:
----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') -----
simulateValueWithArguments: anArray caller: aContext
+ "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
| newContext sz |
- (anArray class ~~ Array
- or: [numArgs ~= anArray size]) ifTrue:
- [^ContextPart primitiveFailTokenFor: nil].
newContext := (MethodContext newForMethod: outerContext method)
setSender: aContext
receiver: outerContext receiver
method: outerContext method
closure: self
startpc: startpc.
+ ((newContext objectClass: anArray) ~~ Array
+ or: [numArgs ~= anArray size]) ifTrue:
+ [^ContextPart primitiveFailTokenFor: nil].
sz := self basicSize.
newContext stackp: sz + numArgs.
1 to: numArgs do:
[:i| newContext at: i put: (anArray at: i)].
1 to: sz do:
[:i| newContext at: i + numArgs put: (self at: i)].
^newContext!
Item was added:
+ ----- Method: Class>>immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
+ immediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new
+ immediate class as a subclass of an existing class (the receiver)."
+ ^ClassBuilder new
+ superclass: self
+ immediateSubclass: t
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was changed:
----- Method: ClassBuilder>>computeFormat:instSize:forSuper:ccIndex: (in category 'class format') -----
computeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
"Compute the new format for making oldClass a subclass of newSuper.
+ Answer the format or nil if there is any problem."
- Return the format or nil if there is any problem."
| instSize isVar isWords isPointers isWeak |
type == #compiledMethod ifTrue:
+ [newInstSize > 0 ifTrue:
+ [self error: 'A compiled method class cannot have named instance variables'.
+ ^nil].
+ ^CompiledMethod format].
- [^(CompiledMethod format
- bitClear: (16r1F bitShift: 11))
- bitOr: (ccIndex bitShift: 11)].
instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
+ instSize > 65535 ifTrue:
- instSize > 254 ifTrue:
[self error: 'Class has too many instance variables (', instSize printString,')'.
^nil].
type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
+ type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
+ type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
+ (isPointers not and: [instSize > 0]) ifTrue:
+ [self error: 'A non-pointer class cannot have named instance variables'.
- (isPointers not and:[instSize > 0]) ifTrue:
- [self error:'A non-pointer class cannot have instance variables'.
^nil].
+ ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
- ^(self format: instSize
- variable: isVar
- words: isWords
- pointers: isPointers
- weak: isWeak) + (ccIndex bitShift: 11).!
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 (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 |
- format: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
- "Compute the format for the given instance specfication."
- | cClass instSpec sizeHiBits fmt |
- self flag: #instSizeChange.
- "
- Smalltalk browseAllCallsOn: #instSizeChange.
- Smalltalk browseAllImplementorsOf: #fixedFieldsOf:.
- Smalltalk browseAllImplementorsOf: #instantiateClass:indexableSize:.
- "
- "
- NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
- For now the format word is...
- <2 bits=instSize//64><5 bits=cClass><4 bits=instSpec><6 bits=instSize\\64><1 bit=0>
- But when we revise the image format, it should become...
- <5 bits=cClass><4 bits=instSpec><8 bits=instSize><1 bit=0>
- "
- sizeHiBits := (nInstVars+1) // 64.
- cClass := 0. "for now"
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!
- ifTrue:[4]
- ifFalse:[isPointers
- ifTrue: [isVar
- ifTrue: [nInstVars>0 ifTrue: [3] ifFalse: [2]]
- ifFalse: [nInstVars>0 ifTrue: [1] ifFalse: [0]]]
- ifFalse: [isWords ifTrue: [6] ifFalse: [8]]].
- fmt := sizeHiBits.
- fmt := (fmt bitShift: 5) + cClass.
- fmt := (fmt bitShift: 4) + instSpec.
- fmt := (fmt bitShift: 6) + ((nInstVars+1)\\64). "+1 since prim size field includes header"
- fmt := (fmt bitShift: 1). "This shift plus integer bit lets wordSize work like byteSize"
- ^fmt!
Item was added:
+ ----- Method: ClassBuilder>>superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
+ superclass: aClass
+ immediateSubclass: t instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a
+ new immediate class as a subclass of an existing class."
+ | env |
+ aClass instSize > 0
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
+ aClass isVariable
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
+ aClass isPointers
+ ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
+ "Cope with pre-environment and environment versions. Simplify asap."
+ env := (Smalltalk classNamed: #EnvironmentRequest)
+ ifNil: [aClass environment]
+ ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
+ ^self
+ name: t
+ inEnvironment: env
+ subclassOf: aClass
+ type: #immediate
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was changed:
----- Method: ClassBuilder>>update:to: (in category 'class mutation') -----
update: oldClass to: newClass
+ "Convert oldClass, all its instances and possibly its meta class into newClass,
+ instances of newClass and possibly its meta class. The process is surprisingly
+ simple in its implementation and surprisingly complex in its nuances and potentially
+ bad side effects.
+ We can rely on two assumptions (which are critical):
+ #1: The method #updateInstancesFrom: will not create any lasting pointers to
+ 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
+ a become of the old vs. the new instances and therefore it will not create
+ pointers to *new* instances before the #become: which are *old* afterwards)
+ #2: The non-preemptive execution of the critical piece of code guarantees that
+ nobody can get a hold by 'other means' (such as process interruption and
+ reflection) on the old instances.
+ Given the above two, we know that after #updateInstancesFrom: there are no pointers
+ to any old instances. After the forwarding become there will be no pointers to the old
+ class or meta class either.
+ Andreas Raab, 2/27/2003 23:42"
- "Convert oldClass, all its instances and possibly its meta class into newClass, instances of newClass and possibly its meta class. The process is surprisingly simple in its implementation and surprisingly complex in its nuances and potentially bad side effects.
- We can rely on two assumptions (which are critical):
- #1: The method #updateInstancesFrom: will not create any lasting pointers to 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do a become of the old vs. the new instances and therefore it will not create pointers to *new* instances before the #become: which are *old* afterwards)
- #2: The non-preemptive execution of the critical piece of code guarantees that nobody can get a hold by 'other means' (such as process interruption and reflection) on the old instances.
- Given the above two, we know that after #updateInstancesFrom: there are no pointer to any old instances. After the forwarding become there will be no pointers to the old class or meta class either. Meaning that if we throw in a nice fat GC at the end of the critical block, everything will be gone (but see the comment right there). There's no need to worry.
- "
| meta |
meta := oldClass isMeta.
"Note: Everything from here on will run without the ability to get interrupted
to prevent any other process to create new instances of the old class."
+ ["Note: The following removal may look somewhat obscure and needs an explanation.
+ When we mutate the class hierarchy we create new classes for any existing subclass.
+ So it may look as if we don't have to remove the old class from its superclass. However,
+ at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
+ created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
+ subclasses. Since the #become: below will transparently replace the pointers to oldClass
+ with newClass the superclass would have newClass in its subclasses TWICE. With rather
+ unclear effects if we consider that we may convert the meta-class hierarchy itself (which
+ is derived from the non-meta class hierarchy).
+ Due to this problem ALL classes are removed from their superclass just prior to converting
+ them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
+ effectively remove the oldClass (becomeForward:) just a few lines below."
- [
- "Note: The following removal may look somewhat obscure and needs an explanation. When we mutate the class hierarchy we create new classes for any existing subclass. So it may look as if we don't have to remove the old class from its superclass. However, at the top of the hierarchy (the first class we reshape) that superclass itself is not newly created so therefore it will hold both the oldClass and newClass in its (obsolete or not) subclasses. Since the #become: below will transparently replace the pointers to oldClass with newClass the superclass would have newClass in its subclasses TWICE. With rather unclear effects if we consider that we may convert the meta-class hierarchy itself (which is derived from the non-meta class hierarchy).
- Due to this problem ALL classes are removed from their superclass just prior to converting them. Here, breaking the superclass/subclass invariant really doesn't matter since we will effectively remove the oldClass (become+GC) just a few lines below."
oldClass superclass removeSubclass: oldClass.
oldClass superclass removeObsoleteSubclass: oldClass.
"make sure that the VM cache is clean"
oldClass methodDict do: [:cm | cm flushCache].
"Convert the instances of oldClass into instances of newClass"
newClass updateInstancesFrom: oldClass.
meta
ifTrue:
[oldClass becomeForward: newClass.
oldClass updateMethodBindingsTo: oldClass binding]
ifFalse:
[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
oldClass updateMethodBindingsTo: oldClass binding.
oldClass class updateMethodBindingsTo: oldClass class binding].
+ "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
+ to ensure no old instances existed after the becomeForward:. Without the GC it was possible
+ to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
+ updated references from the old objects to new objects but didn't destroy the old objects.
+ But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
+ valueUnpreemptively!
- Smalltalk garbageCollect.
-
- "Warning: Read this before you even think about removing the GC. Yes, it slows us down. Quite heavily if you have a large image. However, there's no good and simple alternative here, since unfortunately, #become: does change class pointers. What happens is that after the above become all of the instances of the old class will have a class pointer identifying them as instances of newClass. If we get our hands on any of these instances we will break immediately since their expected instance layout (that of its class, e.g., newClass) will not match their actual instance layout (that of oldClass). And getting your hands on any of those instances is really simple - just reshaping one class two times in rapid succession will do it. Reflection techniques, interrupts, etc. will only add to this problem. In the case of Metaclass things get even worse since when we recompile the entire class hierarchy we will recompile both, Metaclass and its instances (and some of its instances will have the old and some the new layout).
-
- The only easy solution to this problem would be to 'fix up' the class pointers of the old instances to point to the old class (using primitiveChangeClassTo:). But this won't work either - as we do a one-way become we would have to search the entire object memory for the oldClass and couldn't even clearly identify it unless we give it some 'special token' which sounds quite error-prone. If you really need to get rid of the GC here are some alternatives:
-
- On the image level, one could create a copy of the oldClass before becoming it into the new class and, after becoming it, 'fix up' the old instances. That would certainly work but it sounds quite complex, as we need to make sure we're not breaking any of the superclass/subclass meta/non-meta class variants.
-
- Alternatively, fix up #becomeForward on the VM-level to 'dump the source objects' of #become. This would be quite doable (just 'convert' them into a well known special class such as bitmap) yet it has problems if (accidentally or not) one of the objects in #become: appears on 'both sides of the fence' (right now, this will work ... in a way ... even though the consequences are unclear).
-
- Another alternative is to provide a dedicated primitive for this (instead of using it implicitly in become) which would allow us to dump all the existing instances right here. This is equivalent to a more general primitiveChangeClassTo: and might be worthwhile but it would likely have to keep in mind the differences between bits and pointer thingies etc.
-
- Since all of the alternatives seem rather complex and magical compared to a straight-forward GC it seems best to stick with the GC solution for now. If someone has a real need to fix this problem, that person will likely be motivated enough to check out the alternatives. Personally I'd probably go for #1 (copy the old class and remap the instances to it) since it's a solution that could be easily reverted from within the image if there's any problem with it."
-
- ] valueUnpreemptively.
- !
Item was changed:
ByteArray variableByteSubclass: #CompiledMethod
instanceVariableNames: ''
classVariableNames: 'LargeFrame PrimaryBytecodeSetEncoderClass SecondaryBytecodeSetEncoderClass SmallFrame'
poolDictionaries: ''
category: 'Kernel-Methods'!
+ !CompiledMethod commentStamp: 'eem 8/12/2014 14:45' prior: 0!
+ CompiledMethod instances are methods suitable for interpretation by the virtual machine. Instances of CompiledMethod and its subclasses are the only objects in the system that have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. CompiledMethod inherits from ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray.
- !CompiledMethod commentStamp: 'eem 5/12/2014 18:02' prior: 0!
- My instances are methods suitable for interpretation by the virtual machine. This is the only class in the system whose instances have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. I'm a subclass of ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray.
Class variables:
SmallFrame - the number of stack slots in a small frame Context
LargeFrame - the number of stack slots in a large frame Context
PrimaryBytecodeSetEncoderClass - the encoder class that defines the primary instruction set
SecondaryBytecodeSetEncoderClass - the encoder class that defines the secondary instruction set
The current format of a CompiledMethod is as follows:
header (4 or 8 bytes, SmallInteger)
+ literals (4 or 8 bytes each, Object, see "The last literal..." below)
- literals (4 or 8 bytes each, Object)
bytecodes (variable, bytes)
trailer (variable, bytes)
+ The header is a 31-bit signed integer (a SmallInteger) in the following format:
- The header is a 31-bit signed integer (a SmallInteger) with one of the two following formats, selected by the sign bit:
- sign bit 0, header >= 0:
- (index 0) 9 bits: main part of primitive number (#primitive)
- (index 9) 8 bits: number of literals (#numLiterals)
- (index 17) 1 bit: whether a large frame size is needed (#frameSize)
- (index 18) 6 bits: number of temporary variables (#numTemps)
- (index 24) 4 bits: number of arguments to the method (#numArgs)
- (index 28) 1 bit: high-bit of primitive number (#primitive)
- (index 29) 1 bit: flag bit, ignored by the VM (#flag)
- (index 30/63) sign bit: 0 selects the Primary instruction set (#signFlag)
- sign bit 1, header < 0:
(index 0) 16 bits: number of literals (#numLiterals)
(index 16) 1 bit: has primitive
+ (index 17) 1 bit: whether a large frame size is needed (#frameSize => either SmallFrame or LargeFrame)
- (index 17) 1 bit: whether a large frame size is needed (#frameSize)
(index 18) 6 bits: number of temporary variables (#numTemps)
(index 24) 4 bits: number of arguments to the method (#numArgs)
+ (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public), although accessors for bit 29 exist (see #flag).
+ (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4, 0 selects the primary instruction set, e.g. SqueakV3PlusClosures) (#signFlag)
- (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public)
- (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4) (#signFlag)
- i.e. the Secondary Bytecode Set expands the number of literals to 65535 by assuming a CallPrimitive bytecode.
+ If the method has a primitive then the first bytecode of the method must be a callPrimitive: bytecode that encodes the primitive index.
+
+ The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.
+
+ The last literal in a CompiledMethod must be its methodClassAssociation, a binding whose value is the class the method is installed in. The methodClassAssociation is used to implement super sends. If a method contains no super send then its methodClassAssociation may be left nil (as would be the case for example of methods providing a pool of inst var accessors). By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState. AdditionalMethodState holds any pragmas and properties of a method, but may also be used to add instance variables to a method, albeit ones held in the method's AdditionalMethodState. Subclasses of CompiledMethod that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledMethod subclass to answer the specialized subclass of AdditionalMethodState.!
- The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.!
Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 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."
+ | method pc |
+ nArgs > 15 ifTrue:
+ [^self error: 'Cannot compile -- too many arguments'].
- | largeBit primBits |
nTemps > 63 ifTrue:
+ [^self error: 'Cannot compile -- too many temporary variables'].
+ nLits > 65535 ifTrue:
+ [^self error: 'Cannot compile -- too many literals'].
- [^ self error: 'Cannot compile -- too many temporary variables'].
- nLits > 255 ifTrue:
- [^ self error: 'Cannot compile -- too many literals'].
- 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)].
+ 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!
- ^trailer
- createMethod: numberOfBytes
- class: self
- header: (nArgs bitShift: 24) +
- (nTemps bitShift: 18) +
- (largeBit bitShift: 17) +
- (nLits bitShift: 9) +
- 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."
+ | method pc |
+ nArgs > 15 ifTrue:
+ [^self error: 'Cannot compile -- too many arguments'].
- | largeBit primBits flagBit |
nTemps > 63 ifTrue:
+ [^self error: 'Cannot compile -- too many temporary variables'].
+ nLits > 65535 ifTrue:
+ [^self error: 'Cannot compile -- too many literals'].
- [^ self error: 'Cannot compile -- too many temporary variables'].
- nLits > 255 ifTrue:
- [^ self error: 'Cannot compile -- too many literals'].
- largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0].
+ 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!
- "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 ].
-
- ^trailer
- createMethod: numberOfBytes
- class: self
- header: (nArgs bitShift: 24) +
- (nTemps bitShift: 18) +
- (largeBit bitShift: 17) +
- (nLits bitShift: 9) +
- primBits +
- (flagBit bitShift: 29)!
Item was changed:
----- Method: CompiledMethod class>>newMethod:header: (in category 'instance creation') -----
+ newMethod: numberOfBytes header: headerWord
- 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."
- information) is specified the headerWord. 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. Once
- the header of a method is set by this primitive, it cannot be changed in
- any way. Essential. See Object documentation whatIsAPrimitive."
+ <primitive: 79 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingNewMethod: numberOfBytes header: headerWord].
- <primitive: 79>
- (numberOfBytes isInteger and:
- [headerWord isInteger and:
- [numberOfBytes >= 0]]) ifTrue: [
- "args okay; space must be low"
- OutOfMemory signal.
- "retry if user proceeds"
- ^ self newMethod: numberOfBytes header: headerWord
- ].
^self primitiveFailed!
Item was changed:
----- Method: CompiledMethod class>>toReturnConstant:trailerBytes: (in category 'instance creation') -----
toReturnConstant: index trailerBytes: trailer
"Answer an instance of me that is a quick return of the constant
indexed in (true false nil -1 0 1 2)."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index
- !
Item was changed:
----- Method: CompiledMethod class>>toReturnField:trailerBytes: (in category 'instance creation') -----
toReturnField: field trailerBytes: trailer
"Answer an instance of me that is a quick return of the instance variable
indexed by the argument, field."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field
- !
Item was changed:
----- Method: CompiledMethod class>>toReturnSelfTrailerBytes: (in category 'instance creation') -----
toReturnSelfTrailerBytes: trailer
"Answer an instance of me that is a quick return of the instance (^self)."
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!
- ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256
- !
Item was added:
+ ----- Method: CompiledMethod>>bytecodeSetName (in category 'accessing') -----
+ bytecodeSetName
+ ^self encoderClass name copyReplaceAll: 'EncoderFor' with: ''!
Item was changed:
----- Method: CompiledMethod>>headerDescription (in category 'literals') -----
headerDescription
+ "Answer a description containing the information about the form of the
+ receiver and the form of the context needed to run the receiver."
- "Answer a description containing the information about the form of the
- receiver and the form of the context needed to run the receiver."
+ ^(ByteString new: 128) writeStream
+ print: self header; cr;
+ nextPutAll: '"primitive: '; print: self primitive; cr;
+ nextPutAll: ' numArgs: '; print: self numArgs; cr;
+ nextPutAll: ' numTemps: '; print: self numTemps; cr;
+ nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
+ nextPutAll: ' frameSize: '; print: self frameSize; cr;
+ nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
+ nextPut: $"; cr;
+ contents!
- | s |
- s := '' writeStream.
- self header printOn: s.
- s cr; nextPutAll: '"primitive: '.
- self primitive printOn: s.
- s cr; nextPutAll: ' numArgs: '.
- self numArgs printOn: s.
- s cr; nextPutAll: ' numTemps: '.
- self numTemps printOn: s.
- s cr; nextPutAll: ' numLiterals: '.
- self numLiterals printOn: s.
- s cr; nextPutAll: ' frameSize: '.
- self frameSize printOn: s.
- s cr; nextPutAll: ' isClosureCompiled: '.
- self isBlueBookCompiled not printOn: s.
- s nextPut: $"; cr.
- ^ s contents!
Item was changed:
----- Method: CompiledMethod>>numLiterals (in category 'accessing') -----
numLiterals
"Answer the number of literals used by the receiver."
+ ^self header bitAnd: 65535!
- | header |
- ^(header := self header) < 0
- ifTrue: [header bitAnd: 65535]
- ifFalse: [(header bitShift: -9) bitAnd: 16rFF]!
Item was changed:
----- Method: CompiledMethod>>primitive (in category 'accessing') -----
primitive
"Answer the primitive index associated with the receiver.
+ Zero indicates that this is not a primitive method."
+ | initialPC |
+ ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
+ ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
+ ifFalse: [0]!
- Zero indicates that this is not a primitive method.
- In the original header format we currently allow 10 bits of primitive index, but they are
- in two places for backward compatibility. In the new format the primitive index is in the
- last two bytes of a three byte callPrimitive: bytecode. The time to unpack is negligible,
- since the derived primitive function pointer full index is stored in the method cache."
- | header initialPC |
- ^(header := self header) < 0
- ifTrue:
- [(header anyMask: 65536) "Is the hasPrimitive? flag set?"
- ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
- ifFalse: [0]]
- ifFalse:
- [(header bitAnd: 16r1FF) + ((header bitShift: -19) bitAnd: 16r200)]!
Item was changed:
----- Method: ContextPart>>activateReturn:value: (in category 'private') -----
activateReturn: aContext value: value
"Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
+ ^MethodContext
+ sender: self
- ^ self
- activateMethod: ContextPart theReturnMethod
- withArgs: {value}
receiver: aContext
+ method: MethodContext theReturnMethod
+ arguments: {value}!
- class: aContext class!
Item was changed:
----- Method: ContextPart>>doPrimitive:method:receiver:args: (in category 'private') -----
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
+ "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and
+ arguments are given as arguments to this message. If successful, push result and return
+ resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
+ execution needs to be intercepted and simulated to avoid execution running away."
- "Simulate a primitive method whose index is primitiveIndex. The
- simulated receiver and arguments are given as arguments to this message.
- If successful, push result and return resuming context, else ^ PrimitiveFailToken.
- Any primitive which provokes execution needs to be intercepted and simulated
- to avoid execution running away."
| value |
"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
the debugger from entering various run-away activities such as spawning a new
process, etc. Injudicious use results in the debugger not being able to debug
+ interesting code, such as the debugger itself. hence use primitive 19 with care :-)"
- interesting code, such as the debugger itself. hence use primtiive 19 with care :-)"
"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
primitiveIndex = 19 ifTrue:
[ToolSet
debugContext: self
label:'Code simulation error'
contents: nil].
+ ((primitiveIndex between: 201 and: 222)
+ and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
+ [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
+ or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
+ [^receiver simulateValueWithArguments: arguments caller: self].
+ primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
+ [^receiver simulateValueWithArguments: arguments first caller: self]].
- "ContextPart>>blockCopy:; simulated to get startpc right"
- (primitiveIndex = 80 and: [(self objectClass: receiver) includesBehavior: ContextPart])
- ifTrue: [^self push: ((BlockContext newForMethod: receiver method)
- home: receiver home
- startpc: pc + 2
- nargs: (arguments at: 1))].
- (primitiveIndex = 81 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>value[:value:...]"
- ifTrue: [^receiver pushArgs: arguments from: self].
- (primitiveIndex = 82 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>valueWithArguments:"
- ifTrue: [^receiver pushArgs: arguments first from: self].
- primitiveIndex = 83 "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
- ifTrue: [^self send: arguments first
- to: receiver
- with: arguments allButFirst
- super: false].
- primitiveIndex = 84 "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
- ifTrue: [^self send: arguments first
- to: receiver
- with: (arguments at: 2)
- startClass: nil].
- primitiveIndex = 100 "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
- ifTrue: [^self send: arguments first
- to: receiver
- with: (arguments at: 2)
- startClass: (arguments at: 3)].
+ primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
+ [^self send: arguments first to: receiver with: arguments allButFirst super: false].
+ primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
+ [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
+ primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
+ [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
+
"Mutex>>primitiveEnterCriticalSection
Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
[| active effective |
active := Processor activeProcess.
effective := active effectiveProcess.
"active == effective"
value := primitiveIndex = 186
ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
+ ^(self isPrimFailToken: value)
- ^((self objectClass: value) == Array
- and: [value size = 2
- and: [value first == PrimitiveFailToken]])
ifTrue: [value]
ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
[^MethodContext
sender: self
receiver: receiver
method: (arguments at: 2)
arguments: (arguments at: 1)].
"Closure primitives"
(primitiveIndex = 200 and: [self == receiver]) ifTrue:
"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
[^self push: (BlockClosure
outerContext: receiver
startpc: pc + 2
numArgs: arguments first
copiedValues: arguments last)].
- ((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
- or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
- [^receiver simulateValueWithArguments: arguments caller: self].
- primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
- [^receiver simulateValueWithArguments: arguments first caller: self].
primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
[(arguments size = 2
and: [arguments first isInteger
and: [(self objectClass: arguments last) == Array]]) ifFalse:
[^ContextPart primitiveFailTokenFor: nil].
^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method"
ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
ifFalse:
[primitiveIndex = 117 "named primitives"
ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
+ ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
+
+ ^(self isPrimFailToken: value)
- ifFalse:
- [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
- ^((self objectClass: value) == Array
- and: [value size = 2
- and: [value first == PrimitiveFailToken]])
ifTrue: [value]
ifFalse: [self push: value]!
Item was added:
+ ----- Method: ContextPart>>isPrimFailToken: (in category 'private') -----
+ isPrimFailToken: anObject
+ ^(self objectClass: anObject) == Array
+ and: [anObject size = 2
+ and: [anObject first == PrimitiveFailToken]]!
Item was added:
+ ----- Method: ContextPart>>send:to:with:lookupIn: (in category 'controlling') -----
+ send: selector to: rcvr with: arguments lookupIn: lookupClass
+ "Simulate the action of sending a message with selector and arguments
+ to rcvr. The argument, lookupClass, is the class in which to lookup the
+ message. This is the receiver's class for normal messages, but for super
+ messages it will be some specific class related to the source method."
+
+ | meth primIndex val ctxt |
+ (meth := lookupClass lookupSelector: selector) ifNil:
+ [^self send: #doesNotUnderstand:
+ to: rcvr
+ with: {Message selector: selector arguments: arguments}
+ lookupIn: lookupClass].
+ (primIndex := meth primitive) > 0 ifTrue:
+ [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
+ (self isPrimFailToken: val) ifFalse:
+ [^val]].
+ (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
+ [^self error: 'Simulated message ', arguments first selector, ' not understood'].
+ ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
+ primIndex > 0 ifTrue:
+ [ctxt failPrimitiveWith: val].
+ ^ctxt!
Item was changed:
----- Method: ContextPart>>send:to:with:super: (in category 'controlling') -----
+ send: selector to: rcvr with: arguments super: superFlag
+ "Simulate the action of sending a message with selector arguments
+ to rcvr. The argument, superFlag, tells whether the receiver of the
+ message was specified with 'super' in the source method."
- send: selector to: rcvr with: args super: superFlag
- "Simulate the action of sending a message with selector, selector, and
- arguments, args, to receiver. The argument, superFlag, tells whether the
- receiver of the message was specified with 'super' in the source method."
+ ^self send: selector
+ to: rcvr
+ with: arguments
+ lookupIn: (superFlag
+ ifTrue: [self method methodClassAssociation value superclass]
+ ifFalse: [self objectClass: rcvr])!
- | class meth val ctxt |
- class := superFlag
- ifTrue: [self method methodClassAssociation value superclass]
- ifFalse: [self objectClass: rcvr].
- meth := class lookupSelector: selector.
- meth == nil ifTrue:
- [^self
- send: #doesNotUnderstand:
- to: rcvr
- with: (Array with: (Message selector: selector arguments: args))
- super: superFlag].
- val := self tryPrimitiveFor: meth receiver: rcvr args: args.
- ((self objectClass: val) == Array
- and: [val size = 2
- and: [val first == PrimitiveFailToken]]) ifFalse:
- [^val].
- (selector == #doesNotUnderstand:
- and: [class == ProtoObject]) ifTrue:
- [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood'].
- ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class.
- ((self objectClass: val) == Array
- and: [val size = 2
- and: [val first == PrimitiveFailToken
- and: [val last notNil
- and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue:
- [ctxt at: ctxt stackPtr put: val last].
- ^ctxt!
Item was changed:
----- Method: ContextPart>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') -----
tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
+ "Invoke the named primitive for aCompiledMethod, answering its result, or,
+ if the primiitve fails, answering the error code."
- | selector theMethod spec receiverClass |
<primitive: 218 error: ec>
ec ifNotNil:
["If ec is an integer other than -1 there was a problem with primitive 218,
not with the external primitive itself. -1 indicates a generic failure (where
ec should be nil) but ec = nil means primitive 218 is not implemented. So
interpret -1 to mean the external primitive failed with a nil error code."
ec isInteger ifTrue:
[ec = -1
ifTrue: [ec := nil]
+ ifFalse: [self primitiveFailed]]].
+ ^self class primitiveFailTokenFor: ec!
- ifFalse: [self primitiveFailed]].
- ^{PrimitiveFailToken. ec}].
- "Assume a nil error code implies the primitive is not implemented and fall back on the old code."
- "Hack. Attempt to execute the named primitive from the given compiled method"
- arguments size > 8 ifTrue:
- [^{PrimitiveFailToken. nil}].
- selector := #(
- tryNamedPrimitive
- tryNamedPrimitive:
- tryNamedPrimitive:with:
- tryNamedPrimitive:with:with:
- tryNamedPrimitive:with:with:with:
- tryNamedPrimitive:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:with:
- tryNamedPrimitive:with:with:with:with:with:with:with:) at: arguments size+1.
- receiverClass := self objectClass: aReceiver.
- theMethod := receiverClass lookupSelector: selector.
- theMethod == nil ifTrue:
- [^{PrimitiveFailToken. nil}].
- spec := theMethod literalAt: 1.
- spec replaceFrom: 1 to: spec size with: (aCompiledMethod literalAt: 1) startingAt: 1.
- Smalltalk unbindExternalPrimitives.
- ^self object: aReceiver perform: selector withArguments: arguments inClass: receiverClass!
Item was added:
+ ----- Method: InstructionClient>>callPrimitive: (in category 'instruction decoding') -----
+ callPrimitive: pimIndex
+ "V3PlusClosures: 139 10001011 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ NewsqueakV4: 249 11111001 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + ( jjjjjjj * 256)
+ m=1 means inlined primitive, no hard return after execution."!
Item was added:
+ ----- Method: InstructionPrinter>>callPrimitive: (in category 'instruction decoding') -----
+ callPrimitive: index
+ "Print the callPrimitive."
+
+ self print: 'callPrimtive: ' , index printString!
Item was changed:
----- Method: InstructionStream>>interpretV3ClosuresExtension:in:for: (in category 'decoding - private - v3 plus closures') -----
interpretV3ClosuresExtension: offset in: method for: client
| type offset2 byte2 byte3 byte4 |
offset <= 6 ifTrue:
["Extended op codes 128-134"
byte2 := method at: pc. pc := pc + 1.
offset <= 2 ifTrue:
["128-130: extended pushes and pops"
type := byte2 // 64.
offset2 := byte2 \\ 64.
offset = 0 ifTrue:
[type = 0 ifTrue: [^client pushReceiverVariable: offset2].
type = 1 ifTrue: [^client pushTemporaryVariable: offset2].
type = 2 ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)].
type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]].
offset = 1 ifTrue:
[type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2].
type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2].
type = 2 ifTrue: [self error: 'illegalStore'].
type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
offset = 2 ifTrue:
[type = 0 ifTrue: [^client popIntoReceiverVariable: offset2].
type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2].
type = 2 ifTrue: [self error: 'illegalStore'].
type = 3 ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
"131-134: extended sends"
offset = 3 ifTrue: "Single extended send"
[^client send: (method literalAt: byte2 \\ 32 + 1)
super: false numArgs: byte2 // 32].
offset = 4 ifTrue: "Double extended do-anything"
[byte3 := method at: pc. pc := pc + 1.
type := byte2 // 32.
type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1)
super: false numArgs: byte2 \\ 32].
type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1)
super: true numArgs: byte2 \\ 32].
type = 2 ifTrue: [^client pushReceiverVariable: byte3].
type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)].
type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)].
type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3].
type = 6 ifTrue: [^client popIntoReceiverVariable: byte3].
type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
offset = 5 ifTrue: "Single extended send to super"
[^client send: (method literalAt: byte2 \\ 32 + 1)
super: true
numArgs: byte2 // 32].
offset = 6 ifTrue: "Second extended send"
[^client send: (method literalAt: byte2 \\ 64 + 1)
super: false
numArgs: byte2 // 64]].
offset = 7 ifTrue: [^client doPop].
offset = 8 ifTrue: [^client doDup].
offset = 9 ifTrue: [^client pushActiveContext].
byte2 := method at: pc. pc := pc + 1.
offset = 10 ifTrue:
[^byte2 < 128
ifTrue: [client pushNewArrayOfSize: byte2]
ifFalse: [client pushConsArrayWithElements: byte2 - 128]].
- offset = 11 ifTrue: [^self error: 'unusedBytecode'].
byte3 := method at: pc. pc := pc + 1.
+ offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)].
offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3].
offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
"offset = 15"
byte4 := method at: pc. pc := pc + 1.
^client
pushClosureCopyNumCopiedValues: (byte2 bitShift: -4)
numArgs: (byte2 bitAnd: 16rF)
blockSize: (byte3 * 256) + byte4!
Item was changed:
----- Method: Integer class>>initialize (in category 'class initialization') -----
+ initialize
+ "Integer initialize"
+ self initializeLowBitPerByteTable!
- initialize "Integer initialize"
- "Ensure we have the right compact class index"
-
- "LPI has been a compact class forever - just ensure basic correctness"
- (LargePositiveInteger indexIfCompact = 5) ifFalse:[
- (Smalltalk compactClassesArray at: 5)
- ifNil:[LargePositiveInteger becomeCompactSimplyAt: 5]
- ifNotNil:[self error: 'Unexpected compact class setup']].
-
- "Cog requires LNI to be compact at 4 (replacing PseudoContext)"
- (LargeNegativeInteger indexIfCompact = 4) ifFalse:[
- "PseudoContext will likely get removed at some point so write this test
- without introducing a hard dependency"
- (Smalltalk compactClassesArray at: 4) name == #PseudoContext
- ifTrue:[Smalltalk compactClassesArray at: 4 put: nil].
- (Smalltalk compactClassesArray at: 4)
- ifNil:[LargeNegativeInteger becomeCompactSimplyAt: 4]
- ifNotNil:[self error: 'Unexpected compact class setup']].
-
- self initializeLowBitPerByteTable
- !
Item was added:
+ ----- Method: MethodContext class>>allInstances (in category 'enumerating') -----
+ allInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since this context has been created only to
+ compute the existing instances."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ insts nextPut: inst.
+ inst := next].
+ ^insts contents!
Item was changed:
----- Method: MethodContext class>>allInstancesDo: (in category 'private') -----
allInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since evaluation of aBlock will create new contexts."
- "Only count until thisContext since evaluation of aBlock will create new contexts."
- | inst next |
inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
- [inst == thisContext] whileFalse:[
- next := inst nextInstance.
- aBlock value: inst.
- inst := next]
- !
Item was added:
+ ----- Method: MethodContext>>failPrimitiveWith: (in category 'system simulation') -----
+ failPrimitiveWith: maybePrimFailToken
+ "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive:
+ bytecode and store the primitive fail code if there is one and the method consumes it."
+ self skipCallPrimitive.
+ ((self isPrimFailToken: maybePrimFailToken)
+ and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
+ [self at: stackp put: maybePrimFailToken last]!
Item was changed:
----- Method: ProtoObject>>scaledIdentityHash (in category 'comparing') -----
scaledIdentityHash
"For identityHash values returned by primitive 75, answer
+ such values times 2^8. Otherwise, match the existing
+ identityHash implementation"
- such values times 2^18. Otherwise, match the existing
- identityHash implementation"
+ ^self identityHash * 256 "bitShift: 8"!
- ^self identityHash * 262144 "bitShift: 18"!
Item was changed:
==== ERROR ===
Error: Unrecognized class type
27 September 2014 8:29:31.303 pm
VM: unix - a SmalltalkImage
Image: Squeak3.11alpha [latest update: #8824]
SecurityManager state:
Restricted: false
FileAccess: true
SocketAccess: true
Working Dir /home/squeaksource
Trusted Dir /home/squeaksource/secure
Untrusted Dir /home/squeaksource/My Squeak
MCClassDefinition(Object)>>error:
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
aString: 'Unrecognized class type'
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
MCClassDefinition>>kindOfSubclass
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
MCClassDefinition>>printDefinitionOn:
Receiver: a MCClassDefinition(SmallInteger)
Arguments and temporary variables:
stream: a WriteStream
Receiver's instance variables:
name: #SmallInteger
superclassName: #Integer
variables: an OrderedCollection()
category: #'Kernel-Numbers'
type: #immediate
comment: 'My instances are 31-bit numbers, stored in twos complement form. The ...etc...
commentStamp: 'eem 8/12/2014 14:54'
traitComposition: nil
classTraitComposition: nil
[] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
Receiver: a MCDiffyTextWriter
Arguments and temporary variables:
definition: a WriteStream
s: a MCClassDefinition(SmallInteger)
Receiver's instance variables:
stream: a WriteStream
initStream: nil
--- The full stack ---
MCClassDefinition(Object)>>error:
MCClassDefinition>>kindOfSubclass
MCClassDefinition>>printDefinitionOn:
[] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
String class(SequenceableCollection class)>>new:streamContents:
String class(SequenceableCollection class)>>streamContents:
MCDiffyTextWriter(MCTextWriter)>>chunkContents:
MCDiffyTextWriter(MCStWriter)>>writeClassDefinition:
MCDiffyTextWriter(MCStWriter)>>visitClassDefinition:
MCClassDefinition>>accept:
[] in MCDiffyTextWriter(MCTextWriter)>>visitInFork:
String class(SequenceableCollection class)>>new:streamContents:
String class(SequenceableCollection class)>>streamContents:
MCDiffyTextWriter(MCTextWriter)>>visitInFork:
MCDiffyTextWriter>>writePatchFrom:to:
MCDiffyTextWriter>>writeModification:
[] in MCDiffyTextWriter>>writePatch:
SortedCollection(OrderedCollection)>>do:
MCDiffyTextWriter>>writePatch:
SSDiffyTextWriter>>writePatch:
[] in SSDiffyTextWriter>>writeVersion:for:
BlockClosure>>on:do:
SSDiffyTextWriter>>writeVersion:for:
[] in SSEMailSubscription>>versionAdded:to:
BlockClosure>>on:do:
SSEMailSubscription>>versionAdded:to:
[] in [] in SSProject>>versionAdded:
[] in BlockClosure>>newProcess
1
0