Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.622.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.622
Author: eem
Time: 26 February 2014, 11:53:23.432 am
UUID: 7a33af68-b347-4a24-b960-e8755f7c49f3
Ancestors: VMMaker.oscog-eem.621
Improve spread in Spur's identity hash from 64% to 75%.
Make primitiveSizeInBytesOfInstance accept 2 args in Newspeak for
VMMirror.
Try and fix initialization of ProcessorClass in Cogit.
=============== Diff against VMMaker.oscog-eem.621 ===============
Item was changed:
----- Method: Cogit class>>ancilliaryClasses: (in category 'translation') -----
ancilliaryClasses: options
+ ProcessorClass ifNil:
+ [Cogit initializeMiscConstants].
- ProcessorClass ifNil: [thisContext methodClass theNonMetaClass initialize].
^{ CogMethodZone.
CogAbstractInstruction.
ProcessorClass basicNew abstractInstructionCompilerClass.
CogBlockStart.
CogBytecodeDescriptor.
CogBytecodeFixup.
CogInstructionAnnotation.
CogPrimitiveDescriptor.
CogBlockMethod.
CogMethod },
((options at: #NewspeakVM ifAbsent: [false])
ifTrue: [{NewspeakCogMethod}]
ifFalse: [#()])!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSizeInBytesOfInstance (in category 'memory space primitives') -----
primitiveSizeInBytesOfInstance
+ "Answer the byte size of an instance of the receiver. If num args > 0
+ then the last argument is a variable size and the size answered is the
+ size of an instance of the receiver with that many indexable elements."
<option: #SpurObjectMemory>
| byteSizeOrErr |
+ self cppIf: NewspeakVM
+ ifTrue: "Support VMMirror>>byteSizeOfInstanceOf:WithIndexableVariables:"
+ [argumentCount > 2 ifTrue:
+ [^self primitiveFailFor: PrimErrBadNumArgs]]
+ ifFalse:
+ [argumentCount > 1 ifTrue:
+ [^self primitiveFailFor: PrimErrBadNumArgs]].
+ argumentCount >= 1 ifTrue:
- argumentCount > 1 ifTrue:
- [^self primitiveFailFor: PrimErrBadNumArgs].
- argumentCount = 1 ifTrue:
[(objectMemory isIntegerObject: self stackTop) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
byteSizeOrErr := objectMemory
byteSizeOfInstanceOf: (self stackValue: 1)
withIndexableSlots: (objectMemory integerValueOf: self stackTop).
byteSizeOrErr < 0 ifTrue:
[^self primitiveFailFor: byteSizeOrErr negated].
+ ^self pop: argumentCount + 1 thenPushInteger: byteSizeOrErr].
+ byteSizeOrErr := objectMemory byteSizeOfInstanceOf: (self stackValue: 0).
- ^self pop: 2 thenPushInteger: byteSizeOrErr].
- byteSizeOrErr := objectMemory byteSizeOfInstanceOf: (self stackValue: 1).
byteSizeOrErr < 0 ifTrue:
[^self primitiveFailFor: byteSizeOrErr negated].
self pop: 1 thenPushInteger: byteSizeOrErr!
Item was changed:
----- Method: SpurMemoryManager>>newObjectHash (in category 'accessing') -----
newObjectHash
"Use a slight variation on D.H. Lehmer's linear congruential generator from 1951.
See e.g. http://en.wikipedia.org/wiki/Linear_congruential_generator."
+ | hash |
+ [lastHash := self cCode: [lastHash * 16807] "7 raisedTo: 5"
- lastHash := self cCode: [lastHash * 16807] "7 raisedTo: 5"
inSmalltalk: [lastHash := lastHash * 16807 bitAnd: 16rFFFFFFFF].
+ hash := lastHash + (lastHash >> 4). "adding the top bits gives much better spread. See below:"
+ (hash bitAnd: self identityHashHalfWordMask) = 0] whileTrue.
+ ^hash
- self assert: lastHash ~= 0.
- ^lastHash + (lastHash >> 8) "adding the top bits gives much better spread. See below:"
+ "the standard algorithm doesn't vary well in the least significant bits:"
"| r s n |
r := 1.
n := 256 * 256 * 256.
s := Set new: n * 2.
n timesRepeat:
+ [s add: (r bitAnd: n - 1).
- [s add: (r + (r bitShift: -8) bitAnd: n - 1).
r := r * 16807 bitAnd: 16rFFFFFFFF].
{ s size. s size / n asFloat. s includes: 0. r hex }
+ => #(2097152 0.125 false '16r38000001')"
- => #(10702109 0.637895405292511 false '16r38000001')"
+ "this can be improved by adding in shifted upper bits"
"| r s n |
r := 1.
n := 256 * 256 * 256.
s := Set new: n * 2.
n timesRepeat:
+ [s add: (r + (r bitShift: -8) bitAnd: n - 1).
- [s add: (r bitAnd: n - 1).
r := r * 16807 bitAnd: 16rFFFFFFFF].
{ s size. s size / n asFloat. s includes: 0. r hex }
+ => #(10702109 0.637895405292511 false '16r38000001')"
+
+
+ "but which shift is best? Looks like -4:"
+ "(-2 to: -15 by: -1) do:
+ [:shift|
+ | r s n |
+ r := 1.
+ n := 256 * 256 * 256.
+ s := Set new: n * 2.
+ n timesRepeat:
+ [s add: (r + (r bitShift: shift) bitAnd: n - 1).
+ r := r * 16807 bitAnd: 16rFFFFFFFF].
+ Transcript cr; print: { shift. s size. s size / n asFloat. s includes: 0. r hex }; flush]
+
+ #(-2 8388608 0.5 true '16r38000001')
+ #(-3 8388608 0.5 false '16r38000001')
+ #(-4 12582503 0.749975621700287 true '16r38000001')
+ #(-5 11468379 0.6835686564445495 false '16r38000001')
+ #(-6 11013442 0.656452298164368 true '16r38000001')
+ #(-7 10804094 0.643974184989929 true '16r38000001')
+ #(-8 10702109 0.637895405292511 false '16r38000001')
+ #(-9 10703730 0.637992024421692 false '16r38000001')
+ #(-10 7865201 0.468802511692047 false '16r38000001')
+ #(-11 8444092 0.503307104110718 false '16r38000001')
+ #(-12 10703317 0.6379674077034 true '16r38000001')
+ #(-13 10701116 0.637836217880249 true '16r38000001')
+ #(-14 10689443 0.637140452861786 true '16r38000001')
+ #(-15 7853923 0.4681302905082702 true '16r38000001')"!
- => #(2097152 0.125 false '16r38000001')"!
1
0
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.137.mcz
==================== Summary ====================
Name: Cog-eem.137
Author: eem
Time: 26 February 2014, 11:51:16.288 am
UUID: 63230afc-eb3a-49f3-a247-e3dcca870e25
Ancestors: Cog-eem.136
Add a class to patch Newspeak's KernelForSqueak.ns3.
Improve the comments in the instantiation methods and get the
MC package patcher to classify the handle methods under private.
=============== Diff against Cog-eem.136 ===============
Item was changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbasicNew (in category 'method prototypes') -----
BehaviorPROTOTYPEbasicNew
"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 arguments and
+ retry via handleFailingBasicNew if they're OK."
- retry via failingBasicNew: if they're OK."
<primitive: 70>
self isVariable ifTrue: [^self basicNew: 0].
"space must have been low, and the scavenger must have run.
retry after the scavenge."
^self handleFailingBasicNew!
Item was changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbasicNew: (in category 'method prototypes') -----
BehaviorPROTOTYPEbasicNew: 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."
- method is activated. Check arguments and retry via failingBasicNew: if they're OK."
<primitive: 71>
self isVariable ifFalse:
[self error: self printString, ' cannot have variable sized instances'].
(sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue:
["arg okay; space must have been low, and the scavenger must have run.
retry after the scavenge"
^self handleFailingBasicNew: sizeRequested].
self primitiveFailed!
Item was changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEelementSize (in category 'method prototypes') -----
BehaviorPROTOTYPEelementSize
"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)"
- 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, reserved for exotic pointer objects?
- 7 reserved by the VM
- 8 unused, reserved for exotic non-pointer objects?
- 9 (?) 64-bit indexable
- 10 - 11 32-bit indexable
- 12 - 15 16-bit indexable
- 16 - 23 byte indexable
- 24 - 31 compiled method"
| instSpec |
instSpec := self instSpec.
instSpec < 9 ifTrue: [^Smalltalk wordSize].
instSpec >= 16 ifTrue: [^1].
instSpec >= 12 ifTrue: [^2].
instSpec >= 10 ifTrue: [^4].
^8!
Item was changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingBasicNew (in category 'method prototypes') -----
BehaviorPROTOTYPEhandleFailingBasicNew
+ "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.
- "This basicNew 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 failingBasicNew fails then the scavenge failed to reclaim sufficient
- space and a global garbage collection is required.
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 changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingBasicNew: (in category 'method prototypes') -----
BehaviorPROTOTYPEhandleFailingBasicNew: 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.
- "This basicNew: 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.
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 byteSizeOfInstanceWithIndexableVariables: sizeRequested.
Smalltalk garbageCollect < bytesRequested ifTrue:
[Smalltalk growMemoryByAtLeast: bytesRequested].
"retry after global garbage collect and possible grow"
^self handleFailingFailingBasicNew: sizeRequested!
Item was changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingFailingBasicNew (in category 'method prototypes') -----
BehaviorPROTOTYPEhandleFailingFailingBasicNew
+ "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.
- "This basicNew gets sent after failingBasicNew: has sent Smalltalk garbageCollect.
- If this fails then the system really is low on space.
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 changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingFailingBasicNew: (in category 'method prototypes') -----
BehaviorPROTOTYPEhandleFailingFailingBasicNew: 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.
- "This basicNew: gets sent after failingBasicNew: has sent Smalltalk garbageCollect.
- If that fails the system really is low on space.
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."
- "arg okay; space must be low."
OutOfMemory signal.
^self basicNew: sizeRequested "retry if user proceeds"!
Item was changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEidentityHash (in category 'method prototypes') -----
BehaviorPROTOTYPEidentityHash
"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.
- This method must not be overridden.
- Primitive. Fails if the receiver is not a Behavior. Essential.
- See Object documentation whatIsAPrimitive.
+ Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
- Do not override."
<primitive: 175>
self primitiveFailed!
Item was changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
BehaviorPROTOTYPEinstSpec
"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)"
- 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, reserved for exotic pointer objects?
- 7 reserved by the VM
- 8 unused, reserved for exotic non-pointer objects?
- 9 (?) 64-bit indexable
- 10 - 11 32-bit indexable
- 12 - 15 16-bit indexable
- 16 - 23 byte indexable
- 24 - 31 compiled method"
^(format bitShift: -16) bitAnd: 16r1F!
Item was changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisBits (in category 'method prototypes') -----
BehaviorPROTOTYPEisBits
"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!
- 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,7,8 unused
- 9 (?) 64-bit indexable
- 10 - 11 32-bit indexable
- 12 - 15 16-bit indexable
- 16 - 23 byte indexable
- 24 - 31 compiled method"
- ^self instSpec >= 9!
Item was changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisBytes (in category 'method prototypes') -----
BehaviorPROTOTYPEisBytes
"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)"
- 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,7,8 unused
- 9 (?) 64-bit indexable
- 10 - 11 32-bit indexable
- 12 - 15 16-bit indexable
- 16 - 23 byte indexable
- 24 - 31 compiled method"
^self instSpec >= 16!
Item was changed:
----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisVariable (in category 'method prototypes') -----
BehaviorPROTOTYPEisVariable
"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)"
- 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,7,8 unused
- 9 (?) 64-bit indexable
- 10 - 11 32-bit indexable
- 12 - 15 16-bit indexable
- 16 - 23 byte indexable
- 24 - 31 compiled method"
| instSpec |
instSpec := self instSpec.
^instSpec >= 2 and: [instSpec ~= 5]!
Item was added:
+ Object subclass: #SpurBootstrapNewspeakFilePatcher
+ instanceVariableNames: 'source substitutions'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Cog-Bootstrapping'!
Item was added:
+ ----- Method: SpurBootstrapNewspeakFilePatcher>>editTo: (in category 'patching') -----
+ editTo: dest "<FileStream>"
+ source reopen.
+ [substitutions do:
+ [:tuple|
+ [:start :end :substitution|
+ [source position + 1 < start] whileTrue:
+ [dest nextPut: source next].
+ dest nextPutAll: (substitution
+ copyReplaceAll: (String with: Character cr)
+ with: (String with: Character lf)).
+ source skip: end - start + 1] valueWithArguments: tuple].
+ dest nextPutAll: source upToEnd]
+ ensure: [source close]!
Item was added:
+ ----- Method: SpurBootstrapNewspeakFilePatcher>>findClassDeclarationFor:in: (in category 'parsing') -----
+ findClassDeclarationFor: className in: ast "<ClassDeclarationAST>" "^(ClassDeclarationAST|nil)"
+ ^ast instanceSide nestedClasses
+ detect: [:classDecl| classDecl name = className]
+ ifNone: []!
Item was added:
+ ----- Method: SpurBootstrapNewspeakFilePatcher>>findMethodDeclarationFor:in: (in category 'parsing') -----
+ findMethodDeclarationFor: selector "<Symbol>" in: ast "<ClassDeclarationAST>" "^(MethodAST|nil)"
+ ast instanceSide categories do:
+ [:categoryAST|
+ categoryAST methods do:
+ [:methodAST|
+ methodAST pattern selector = selector ifTrue:
+ [^methodAST]]].
+ ^nil!
Item was added:
+ ----- Method: SpurBootstrapNewspeakFilePatcher>>initialize (in category 'initialize-release') -----
+ initialize
+ substitutions := SortedCollection sortBlock: [:tupleA :tupleB | tupleA first <= tupleB first]!
Item was added:
+ ----- Method: SpurBootstrapNewspeakFilePatcher>>newspeakSourceFor:selector: (in category 'patching') -----
+ newspeakSourceFor: method "<CompiledMethod>" selector: selector "<Symbol>"
+ | source startIndex nextIndex |
+ source := method getSourceFromFile asString allButFirst: method selector size - selector size.
+ source first ~= selector first ifTrue:
+ [source replaceFrom: 1 to: selector size with: selector startingAt: 1].
+
+ "map comments to Newspeak format..."
+ startIndex := 1.
+ [(startIndex := source indexOf: $" startingAt: startIndex) > 0] whileTrue:
+ [nextIndex := source indexOf: $" startingAt: startIndex + 1.
+ nextIndex < startIndex ifTrue:
+ [self error: 'matching close comment not found'].
+ source := source copyReplaceFrom: nextIndex to: nextIndex with: ' *)'.
+ source := source copyReplaceFrom: startIndex to: startIndex with: '(* '.
+ startIndex := nextIndex + 5].
+
+ "add the horror-show parentheses"
+ startIndex := source indexOf: Character cr.
+ source := source copyReplaceFrom: startIndex to: startIndex - 1 with: ' = ('.
+ source := source, (String with: Character cr with: $) ).
+ ^source!
Item was added:
+ ----- Method: SpurBootstrapNewspeakFilePatcher>>parse (in category 'parsing') -----
+ parse
+ | platform |
+ platform := BlackMarket platform.
+ ^[(NewspeakParsing
+ usingPlatform: platform
+ grammar: (NewspeakGrammar parserLib: (CombinatorialParsing usingPlatform: platform))
+ asts: (NewspeakASTs usingLib: platform)) Parser new compilationUnit parse: source]
+ ensure: [source close]!
Item was added:
+ ----- Method: SpurBootstrapNewspeakFilePatcher>>patch:inDirectory: (in category 'patching') -----
+ patch: className inDirectory: dir
+ "SpurBootstrapNewspeakFilePatcher new
+ patch: 'KernelForSqueak'
+ inDirectory: '../newspeak'"
+ | directory |
+ directory := FileDirectory default directoryNamed: dir.
+ source := directory oldFileNamed: className, '.ns3'.
+ self substitute: self parse.
+ self editTo: (directory forceNewFileNamed: className, '.ns3.patched')!
Item was added:
+ ----- Method: SpurBootstrapNewspeakFilePatcher>>substitute: (in category 'patching') -----
+ substitute: ast "<ClassDeclarationAST>"
+
+ SpurBootstrap new prototypeClassNameMetaSelectorMethodDo:
+ [:className :isMeta :selector :method| | source |
+ method primitive = 0 ifTrue: "all primitives are in the VMMirror package"
+ [(self findClassDeclarationFor: className in: ast) ifNotNil:
+ [:classDecl|
+ (self findMethodDeclarationFor: selector in: classDecl) ifNotNil:
+ [:methodDecl|
+ source := self newspeakSourceFor: method selector: selector.
+ substitutions add: {methodDecl start. methodDecl end. source}]]]]!
1
0
Thanks to the International Order of Squeak Virtual Machine Builders and Knights of the Square Bracket
by gettimothy 26 Feb '14
by gettimothy 26 Feb '14
26 Feb '14
I got the Standard VM per Dave's work at http://wiki.squeak.org/squeak/6177 Works like a charm and has helped me immensely in that I now know I can build on my 64 bit linux with the compat-libs. that is a huge confidence builder.
1. I have the same issues with StackInterpreter on a native 32 bit machine (builds, don't run) as I do on my 64 bit workstation with aformentioned libs--so that is good news as well--I can debug on my powerful workstation with 16Gigs of memory rather than
the 32 bit box with 128Mb of memory (:
2. I am going to attempt the pharo process and the 64 bit squeaks next before returning to the StackInterpreter work.
3. Does the CoInterpreter VMMaker on Squeak process currently work? I read a VMMaker.oscog commit a while back where Eliot commented that "he got it to compile"
When I attempt to generate the sources, I get a debugger and I don't want to debug this if the code base is in flux while Spur work is going on.
cheers!
tty.
Squeako ergo sum. Artificiosum odi. Noli me vocare, ego ce vocare, ego te vocabo. Fac uc gaudeam. vencis secundis, cene cursum. vescere bracis meis.
3
5
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.621.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.621
Author: eem
Time: 24 February 2014, 2:23:42.1 pm
UUID: 5b811028-86e2-4574-9163-5e47f4c7f3eb
Ancestors: VMMaker.oscog-eem.620
Use followForward: when accessing the elements of the array(s) in
become, since there's nothing that ensures uniqueness and/or
disjointness in the elements. Hence explicitly filter-out an object
becomming itself.
=============== Diff against VMMaker.oscog-eem.620 ===============
Item was changed:
----- Method: SpurMemoryManager>>innerBecomeObjectsIn:and:copyHash: (in category 'become implementation') -----
innerBecomeObjectsIn: array1 and: array2 copyHash: copyHashFlag
"Inner loop of two-way become."
0 to: (self numSlotsOf: array1) - 1 do:
[:i| | obj1 obj2 |
+ "At first blush it would appear unnecessary to use followField: here since
+ the validation in become:with:twoWay:copyHash: follows forwarders. But
+ there's nothing to ensure all elements of each array is unique and doesn't
+ appear in the other array. So the enumeration could encounter an object
+ already becommed earlier in the same enumeration."
+ obj1 := self followField: i ofObject: array1.
+ obj2 := self followField: i ofObject: array2.
+ obj1 ~= obj2 ifTrue:
+ [self doBecome: obj1 and: obj2 copyHash: copyHashFlag.
+ self followField: i ofObject: array1.
+ self followField: i ofObject: array2]]!
- obj1 := self fetchPointer: i ofObject: array1.
- obj2 := self fetchPointer: i ofObject: array2.
- self doBecome: obj1 and: obj2 copyHash: copyHashFlag.
- (self isForwarded: obj1) ifTrue:
- [obj1 := self followForwarded: obj1.
- self storePointer: i ofObject: array1 withValue: obj1].
- (self isForwarded: obj2) ifTrue:
- [obj2 := self followForwarded: obj2.
- self storePointer: i ofObject: array2 withValue: obj2]]!
Item was changed:
----- Method: SpurMemoryManager>>innerBecomeObjectsIn:to:copyHash: (in category 'become implementation') -----
innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag
"Inner loop of one-way become."
0 to: (self numSlotsOf: array1) - 1 do:
[:i| | obj1 obj2 |
+ "At first blush it would appear unnecessary to use followField: here since
+ the validation in become:with:twoWay:copyHash: follows forwarders. But
+ there's nothing to ensure all elements of each array is unique and doesn't
+ appear in the other array. So the enumeration could encounter an object
+ already becommed earlier in the same enumeration."
+ obj1 := self followField: i ofObject: array1.
+ obj2 := self followField: i ofObject: array2.
+ obj1 ~= obj2 ifTrue:
+ [self doBecome: obj1 to: obj2 copyHash: copyHashFlag.
+ self followField: i ofObject: array1.
+ self assert: (self isForwarded: obj2) not]]!
- obj1 := self fetchPointer: i ofObject: array1.
- obj2 := self fetchPointer: i ofObject: array2.
- self doBecome: obj1 to: obj2 copyHash: copyHashFlag.
- (self isForwarded: obj1) ifTrue:
- [obj1 := self followForwarded: obj1.
- self storePointer: i ofObject: array1 withValue: obj1].
- self assert: (self isForwarded: obj2) not]!
1
0
Hi David, you might want to check the accessors. For example, in the below you added getNilObj but (at least in Cog) there's already nilObject, trueObject et al to access nilObj, trueObj et al.
Eliot (phone)
On Feb 23, 2014, at 8:36 AM, commits(a)source.squeak.org wrote:
>
> David T. Lewis uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker-dtl.342.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker-dtl.342
> Author: dtl
> Time: 23 February 2014, 10:37:08.672 am
> UUID: b96b3f58-94e9-45e0-a1b5-833b62ca2284
> Ancestors: VMMaker-dtl.341
>
> VMMaker 4.13.3
>
> Make it possible to produce a working VM with inlining disabled.
>
> To build a VM without inlining: A VMMaker instance has an #inline variable, set it false to disable inlining. During build, disable the gnufication step.
>
> Changes are:
>
> Fix BalloonEnginePlugin>>stepToNextBezierForward:at: by removing unneeded cCoerce (this was an earlier workaround for a slang generation bug, no longer relevant).
>
> Rename accessors in ObjectMemory and Interpreter to prevent name clashes in generated code. For variable foo the accessors would be getFoo and setFoo. Accessors are required because the object memory and interpreter have been factored into separate hierarchies.
>
> For variables that represent C arrays, provide accessors such as fooAt: and fooAt:put: for array access.
>
> =============== Diff against VMMaker-dtl.341 ===============
>
> Item was changed:
> ----- Method: BalloonEnginePlugin>>stepToNextBezierForward:at: (in category 'beziers-simple') -----
> stepToNextBezierForward: updateData at: yValue
> + "Incrementally step to the next scan line in the given bezier update data."
> - "Incrementally step to the next scan line in the given bezier update data.
> - Note: This method has been written so that inlining works, e.g.,
> - not declaring updateData as 'int*' but casting it on every use."
> | minY lastX lastY fwDx fwDy |
> <inline: true>
> + <var: #updateData type: 'int *'>
> + lastX := updateData at: GBUpdateX.
> + lastY := updateData at: GBUpdateY.
> + fwDx := updateData at: GBUpdateDX.
> + fwDy := updateData at: GBUpdateDY.
> - lastX := (self cCoerce: updateData to: 'int*') at: GBUpdateX.
> - lastY := (self cCoerce: updateData to: 'int*') at: GBUpdateY.
> - fwDx := (self cCoerce: updateData to: 'int*') at: GBUpdateDX.
> - fwDy := (self cCoerce: updateData to: 'int*') at: GBUpdateDY.
> minY := yValue * 256.
> "Step as long as we haven't yet reached minY and also
> as long as fwDy is greater than zero thus stepping down.
> Note: The test for fwDy should not be necessary in theory
> but is a good insurance in practice."
> [minY > lastY and:[fwDy >= 0]] whileTrue:[
> lastX := lastX + ((fwDx + 16r8000) // 16r10000).
> lastY := lastY + ((fwDy + 16r8000) // 16r10000).
> + fwDx := fwDx + (updateData at: GBUpdateDDX).
> + fwDy := fwDy + (updateData at: GBUpdateDDY).
> - fwDx := fwDx + ((self cCoerce: updateData to: 'int*') at: GBUpdateDDX).
> - fwDy := fwDy + ((self cCoerce: updateData to: 'int*') at: GBUpdateDDY).
> ].
> + updateData at: GBUpdateX put: lastX.
> + updateData at: GBUpdateY put: lastY.
> + updateData at: GBUpdateDX put: fwDx.
> + updateData at: GBUpdateDY put: fwDy.
> - (self cCoerce: updateData to: 'int*') at: GBUpdateX put: lastX.
> - (self cCoerce: updateData to: 'int*') at: GBUpdateY put: lastY.
> - (self cCoerce: updateData to: 'int*') at: GBUpdateDX put: fwDx.
> - (self cCoerce: updateData to: 'int*') at: GBUpdateDY put: fwDy.
> ^lastX // 256
> !
>
> Item was added:
> + ----- Method: ClassicObjectMemory>>getYoungStart (in category 'accessing') -----
> + getYoungStart
> + <returnTypeC: #usqInt>
> + ^youngStart!
>
> Item was added:
> + ----- Method: ClassicObjectMemory>>startOfFreeSpace (in category 'accessing') -----
> + startOfFreeSpace
> + <returnTypeC: #usqInt>
> + ^freeBlock!
>
> Item was removed:
> - ----- Method: ClassicObjectMemory>>youngStart (in category 'accessing') -----
> - youngStart
> - ^youngStart!
>
> Item was changed:
> ----- Method: Interpreter>>activateNewMethod (in category 'message sending') -----
> activateNewMethod
> | newContext methodHeader initialIP tempCount nilOop where |
>
> methodHeader := self headerOf: newMethod.
> newContext := objectMemory allocateOrRecycleContext: (methodHeader bitAnd: LargeContextBit).
>
> initialIP := ((LiteralStart + (self literalCountOfHeader: methodHeader)) * objectMemory bytesPerWord) + 1.
> tempCount := (methodHeader >> 19) bitAnd: 16r3F.
>
> "Assume: newContext will be recorded as a root if necessary by the
> call to newActiveContext: below, so we can use unchecked stores."
>
> where := newContext + objectMemory baseHeaderSize.
> objectMemory longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
> objectMemory longAt: where + (InstructionPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: initialIP).
> objectMemory longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
> objectMemory longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
> + objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory getNilObj.
> - objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory nilObj.
>
> "Copy the receiver and arguments..."
> 0 to: argumentCount do:
> [:i | objectMemory longAt: where + ((ReceiverIndex+i) << objectMemory shiftForWord) put: (self stackValue: argumentCount-i)].
>
> "clear remaining temps to nil in case it has been recycled"
> + nilOop := objectMemory getNilObj.
> - nilOop := objectMemory nilObj.
> argumentCount+1+ReceiverIndex to: tempCount+ReceiverIndex do:
> [:i | objectMemory longAt: where + (i << objectMemory shiftForWord) put: nilOop].
>
> self pop: argumentCount + 1.
> reclaimableContextCount := reclaimableContextCount + 1.
> self newActiveContext: newContext.!
>
> Item was changed:
> ----- Method: Interpreter>>assertClassOf:is: (in category 'utilities') -----
> assertClassOf: oop is: classOop
> "Succeed if the given (non-integer) object is an instance of the given class. Fail if the object is an integer."
>
> | ccIndex cl |
> <inline: true>
> (objectMemory isIntegerObject: oop)
> ifTrue: [ self primitiveFail. ^ nil ].
>
> ccIndex := ((objectMemory baseHeader: oop) >> 12) bitAnd: 16r1F.
> ccIndex = 0
> ifTrue: [ cl := ((objectMemory classHeader: oop) bitAnd: objectMemory allButTypeMask) ]
> ifFalse: [
> "look up compact class"
> cl := (objectMemory fetchPointer: (ccIndex - 1)
> + ofObject: (objectMemory fetchPointer: CompactClasses ofObject: objectMemory getSpecialObjectsOop))].
> - ofObject: (objectMemory fetchPointer: CompactClasses ofObject: objectMemory specialObjectsOop))].
>
> self success: cl = classOop.
> !
>
> Item was changed:
> ----- Method: Interpreter>>booleanCheat: (in category 'utilities') -----
> booleanCheat: cond
> "cheat the interpreter out of the pleasure of handling the next bytecode IFF it is a jump-on-boolean. Which it is, often enough when the current bytecode is something like bytecodePrimEqual"
> | bytecode offset |
> <inline: true>
>
> bytecode := self fetchByte. "assume next bytecode is jumpIfFalse (99%)"
> self internalPop: 2.
> (bytecode < 160 and: [bytecode > 151]) ifTrue: [ "short jumpIfFalse"
> cond
> ifTrue: [^ self fetchNextBytecode]
> ifFalse: [^ self jump: bytecode - 151]].
>
> bytecode = 172 ifTrue: [ "long jumpIfFalse"
> offset := self fetchByte.
> cond
> ifTrue: [^ self fetchNextBytecode]
> ifFalse: [^ self jump: offset]].
>
> "not followed by a jumpIfFalse; undo instruction fetch and push boolean result"
> localIP := localIP - 1.
> self fetchNextBytecode.
> cond
> + ifTrue: [self internalPush: objectMemory getTrueObj]
> + ifFalse: [self internalPush: objectMemory getFalseObj].
> - ifTrue: [self internalPush: objectMemory trueObj]
> - ifFalse: [self internalPush: objectMemory falseObj].
> !
>
> Item was changed:
> ----- Method: Interpreter>>booleanValueOf: (in category 'utilities') -----
> booleanValueOf: obj
> "convert true and false (Smalltalk) to true or false(C)"
> + obj = objectMemory getTrueObj ifTrue: [ ^ true ].
> + obj = objectMemory getFalseObj ifTrue: [ ^ false ].
> - obj = objectMemory trueObj ifTrue: [ ^ true ].
> - obj = objectMemory falseObj ifTrue: [ ^ false ].
> self primitiveFail.
> ^ nil!
>
> Item was changed:
> ----- Method: Interpreter>>byteSwapByteObjects (in category 'image save/restore') -----
> byteSwapByteObjects
> "Byte-swap the words of all bytes objects in the image. This returns these objects to their original byte ordering after blindly byte-swapping the entire image."
>
> + self byteSwapByteObjectsFrom: objectMemory firstObject to: objectMemory getEndOfMemory!
> - self byteSwapByteObjectsFrom: objectMemory firstObject to: objectMemory endOfMemory!
>
> Item was changed:
> ----- Method: Interpreter>>capturePendingFinalizationSignals (in category 'debug support') -----
> capturePendingFinalizationSignals
> + objectMemory setStatpendingFinalizationSignals: pendingFinalizationSignals.
> - objectMemory statpendingFinalizationSignals: pendingFinalizationSignals.
> !
>
> Item was changed:
> ----- Method: Interpreter>>changeClassOf:to: (in category 'object access primitives') -----
> changeClassOf: rcvr to: argClass
> "Change the class of the receiver into the class specified by the argument given that the format of the receiver matches the format of the argument. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have."
> | classHdr sizeHiBits byteSize argFormat rcvrFormat ccIndex |
> "Check what the format of the class says"
> classHdr := objectMemory formatOfClass: argClass. "Low 2 bits are 0"
>
> "Compute the size of instances of the class (used for fixed field classes only)"
> sizeHiBits := (classHdr bitAnd: 16r60000) >> 9.
> classHdr := classHdr bitAnd: 16r1FFFF.
> byteSize := (classHdr bitAnd: objectMemory sizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
>
> "Check the receiver's format against that of the class"
> argFormat := (classHdr >> 8) bitAnd: 16rF.
> rcvrFormat := objectMemory formatOf: rcvr.
> argFormat = rcvrFormat ifFalse:[^self primitiveFail]. "no way"
>
> "For fixed field classes, the sizes must match.
> Note: byteSize-4 because base header is included in class size."
> argFormat < 2 ifTrue:[(byteSize - objectMemory baseHeaderSize) = (objectMemory byteSizeOf: rcvr) ifFalse:[^self primitiveFail]].
>
> (objectMemory headerType: rcvr) = HeaderTypeShort
> ifTrue:[ "Compact classes. Check if the arg's class is compact and exchange ccIndex"
> ccIndex := classHdr bitAnd: CompactClassMask.
> ccIndex = 0 ifTrue:[^self primitiveFail]. "class is not compact"
> objectMemory longAt: rcvr put:
> (((objectMemory longAt: rcvr) bitAnd: CompactClassMask bitInvert32)
> bitOr: ccIndex)]
> ifFalse:["Exchange the class pointer, which could make rcvr a root for argClass"
> objectMemory longAt: rcvr - objectMemory baseHeaderSize put: (argClass bitOr: (objectMemory headerType: rcvr)).
> + (objectMemory oop: rcvr isLessThan: objectMemory getYoungStart)
> - (objectMemory oop: rcvr isLessThan: objectMemory youngStart)
> ifTrue: [objectMemory possibleRootStoreInto: rcvr value: argClass]]!
>
> Item was changed:
> ----- Method: Interpreter>>checkForInterrupts (in category 'process primitive support') -----
> checkForInterrupts
> "Check for possible interrupts and handle one if necessary."
> | sema now |
> <inline: false>
>
> "Mask so same wrapping as primitiveMillisecondClock"
> now := self ioMSecs bitAnd: MillisecondClockMask.
>
> self interruptCheckForced ifFalse: [
> "don't play with the feedback if we forced a check. It only makes life difficult"
> now - lastTick < interruptChecksEveryNms
> ifTrue: ["wrapping is not a concern, it'll get caught quickly
> enough. This clause is trying to keep a reasonable
> guess of how many times per interruptChecksEveryNms we are calling
> quickCheckForInterrupts. Not sure how effective it really is."
> interruptCheckCounterFeedBackReset := interruptCheckCounterFeedBackReset + 10]
> ifFalse: [interruptCheckCounterFeedBackReset <= 1000
> ifTrue: [interruptCheckCounterFeedBackReset := 1000]
> ifFalse: [interruptCheckCounterFeedBackReset := interruptCheckCounterFeedBackReset - 12]]].
>
> "reset the interrupt check counter"
> interruptCheckCounter := interruptCheckCounterFeedBackReset.
>
> + objectMemory getSignalLowSpace
> + ifTrue: [objectMemory setSignalLowSpace: false. "reset flag"
> - objectMemory signalLowSpace
> - ifTrue: [objectMemory signalLowSpace: false. "reset flag"
> sema := objectMemory splObj: TheLowSpaceSemaphore.
> + sema = objectMemory getNilObj ifFalse: [self synchronousSignal: sema]].
> - sema = objectMemory nilObj ifFalse: [self synchronousSignal: sema]].
>
> now < lastTick
> ifTrue: ["millisecond clock wrapped so correct the nextPollTick"
> nextPollTick := nextPollTick - MillisecondClockMask - 1].
> now >= nextPollTick
> ifTrue: [self ioProcessEvents.
> "sets interruptPending if interrupt key pressed"
> nextPollTick := now + 200
> "msecs to wait before next call to ioProcessEvents.
> Note that strictly speaking we might need to update
> 'now' at this point since ioProcessEvents could take a
> very long time on some platforms"].
> interruptPending
> ifTrue: [interruptPending := false.
> "reset interrupt flag"
> sema := objectMemory splObj: TheInterruptSemaphore.
> + sema = objectMemory getNilObj
> - sema = objectMemory nilObj
> ifFalse: [self synchronousSignal: sema]].
>
> nextWakeupTick ~= 0
> ifTrue: [now < lastTick
> ifTrue: ["the clock has wrapped. Subtract the wrap
> interval from nextWakeupTick - this might just
> possibly result in 0. Since this is used as a flag
> value for 'no timer' we do the 0 check above"
> nextWakeupTick := nextWakeupTick - MillisecondClockMask - 1].
> now >= nextWakeupTick
> ifTrue: [nextWakeupTick := 0.
> "set timer interrupt to 0 for 'no timer'"
> sema := objectMemory splObj: TheTimerSemaphore.
> + sema = objectMemory getNilObj ifFalse: [self synchronousSignal: sema]]].
> - sema = objectMemory nilObj ifFalse: [self synchronousSignal: sema]]].
>
> "signal any pending finalizations"
> pendingFinalizationSignals > 0
> ifTrue: [sema := objectMemory splObj: TheFinalizationSemaphore.
> (objectMemory fetchClassOf: sema) = (objectMemory splObj: ClassSemaphore)
> ifTrue: [self synchronousSignal: sema].
> pendingFinalizationSignals := 0].
>
> "signal all semaphores in semaphoresToSignal"
> (semaphoresToSignalCountA > 0 or: [semaphoresToSignalCountB > 0])
> ifTrue: [self signalExternalSemaphores].
>
> "update the tracking value"
> lastTick := now!
>
> Item was changed:
> ----- Method: Interpreter>>commonReturn (in category 'return bytecodes') -----
> commonReturn
> "Note: Assumed to be inlined into the dispatch loop."
>
> | nilOop thisCntx contextOfCaller localCntx localVal unwindMarked |
> <inline: true>
> self sharedCodeNamed: 'commonReturn' inCase: 120.
>
> + nilOop := objectMemory getNilObj. "keep in a register"
> - nilOop := objectMemory nilObj. "keep in a register"
> thisCntx := activeContext.
> localCntx := localReturnContext.
> localVal := localReturnValue.
>
> "make sure we can return to the given context"
> ((localCntx = nilOop) or:
> [(objectMemory fetchPointer: InstructionPointerIndex ofObject: localCntx) = nilOop]) ifTrue: [
> "error: sender's instruction pointer or context is nil; cannot return"
> ^self internalCannotReturn: localVal].
>
> "If this return is not to our immediate predecessor (i.e. from a method to its sender, or from a block to its caller), scan the stack for the first unwind marked context and inform this context and let it deal with it. This provides a chance for ensure unwinding to occur."
> thisCntx := objectMemory fetchPointer: SenderIndex ofObject: activeContext.
>
> "Just possibly a faster test would be to compare the homeContext and activeContext - they are of course different for blocks. Thus we might be able to optimise a touch by having a different returnTo for the blockreteurn (since we know that must return to caller) and then if active ~= home we must be doing a non-local return. I think. Maybe."
> [thisCntx = localCntx] whileFalse: [
> thisCntx = nilOop ifTrue:[
> "error: sender's instruction pointer or context is nil; cannot return"
> ^self internalCannotReturn: localVal].
> "Climb up stack towards localCntx. Break out to a send of #aboutToReturn:through: if an unwind marked context is found"
> unwindMarked := self isUnwindMarked: thisCntx.
> unwindMarked ifTrue:[
> "context is marked; break out"
> ^self internalAboutToReturn: localVal through: thisCntx].
> thisCntx := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
> ].
>
> "If we get here there is no unwind to worry about. Simply terminate the stack up to the localCntx - often just the sender of the method"
> thisCntx := activeContext.
> [thisCntx = localCntx]
> whileFalse:
> ["climb up stack to localCntx"
> contextOfCaller := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
>
> "zap exited contexts so any future attempted use will be caught"
> objectMemory storePointerUnchecked: SenderIndex ofObject: thisCntx withValue: nilOop.
> objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: thisCntx withValue: nilOop.
> reclaimableContextCount > 0 ifTrue:
> ["try to recycle this context"
> reclaimableContextCount := reclaimableContextCount - 1.
> objectMemory recycleContextIfPossible: thisCntx].
> thisCntx := contextOfCaller].
>
> activeContext := thisCntx.
> + (objectMemory oop: thisCntx isLessThan: objectMemory getYoungStart) ifTrue: [ objectMemory beRootIfOld: thisCntx ].
> - (objectMemory oop: thisCntx isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: thisCntx ].
>
> self internalFetchContextRegisters: thisCntx. "updates local IP and SP"
> self fetchNextBytecode.
> self internalPush: localVal.
> !
>
> Item was changed:
> ----- Method: Interpreter>>context:hasSender: (in category 'contexts') -----
> context: thisCntx hasSender: aContext
> "Does thisCntx have aContext in its sender chain?"
> | s nilOop |
> <inline: true>
> thisCntx == aContext ifTrue: [^false].
> + nilOop := objectMemory getNilObj.
> - nilOop := objectMemory nilObj.
> s := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
> [s == nilOop]
> whileFalse: [s == aContext ifTrue: [^true].
> s := objectMemory fetchPointer: SenderIndex ofObject: s].
> ^false!
>
> Item was changed:
> ----- Method: Interpreter>>dumpImage: (in category 'image save/restore') -----
> dumpImage: fileName
> "Dump the entire image out to the given file. Intended for debugging only."
> | f dataSize result |
> <export: true>
> <var: #fileName type: 'char *'>
> <var: #f type: 'sqImageFile'>
>
> f := self cCode: 'sqImageFileOpen(fileName, "wb")'.
> f = nil ifTrue: [^-1].
> + dataSize := objectMemory getEndOfMemory - objectMemory startOfMemory.
> - dataSize := objectMemory endOfMemory - objectMemory startOfMemory.
> result := self cCode: 'sqImageFileWrite(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
> self cCode: 'sqImageFileClose(f)'.
> ^result
> !
>
> Item was changed:
> ----- Method: Interpreter>>fetchContextRegisters: (in category 'contexts') -----
> fetchContextRegisters: activeCntx
> "Note: internalFetchContextRegisters: should track changes to this method."
> | tmp |
> <inline: true>
> tmp := objectMemory fetchPointer: MethodIndex ofObject: activeCntx.
> (objectMemory isIntegerObject: tmp)
> ifTrue: ["if the MethodIndex field is an integer, activeCntx is a block context"
> tmp := objectMemory fetchPointer: HomeIndex ofObject: activeCntx.
> + (objectMemory oop: tmp isLessThan: objectMemory getYoungStart) ifTrue: [objectMemory beRootIfOld: tmp]]
> - (objectMemory oop: tmp isLessThan: objectMemory youngStart) ifTrue: [objectMemory beRootIfOld: tmp]]
> ifFalse: ["otherwise, it is a method context and is its own home context "
> tmp := activeCntx].
> theHomeContext := tmp.
> receiver := objectMemory fetchPointer: ReceiverIndex ofObject: tmp.
> method := objectMemory fetchPointer: MethodIndex ofObject: tmp.
>
> "the instruction pointer is a pointer variable equal to
> method oop + ip + objectMemory baseHeaderSize
> -1 for 0-based addressing of fetchByte
> -1 because it gets incremented BEFORE fetching currentByte "
> tmp := self quickFetchInteger: InstructionPointerIndex ofObject: activeCntx.
> instructionPointer := method + tmp + objectMemory baseHeaderSize - 2.
>
> "the stack pointer is a pointer variable also..."
> tmp := self quickFetchInteger: StackPointerIndex ofObject: activeCntx.
> stackPointer := activeCntx + objectMemory baseHeaderSize + (TempFrameStart + tmp - 1 * objectMemory bytesPerWord)!
>
> Item was changed:
> ----- Method: Interpreter>>findClassOfMethod:forReceiver: (in category 'debug support') -----
> findClassOfMethod: meth forReceiver: rcvr
>
> | currClass classDict classDictSize methodArray i done |
> currClass := objectMemory fetchClassOf: rcvr.
> done := false.
> [done] whileFalse: [
> classDict := objectMemory fetchPointer: MessageDictionaryIndex ofObject: currClass.
> classDictSize := objectMemory fetchWordLengthOf: classDict.
> methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
> i := 0.
> [i < (classDictSize - SelectorStart)] whileTrue: [
> meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: [ ^currClass ].
> i := i + 1.
> ].
> currClass := objectMemory fetchPointer: SuperclassIndex ofObject: currClass.
> + done := currClass = objectMemory getNilObj.
> - done := currClass = objectMemory nilObj.
> ].
> ^objectMemory fetchClassOf: rcvr "method not found in superclass chain"!
>
> Item was changed:
> ----- Method: Interpreter>>findSelectorOfMethod:forReceiver: (in category 'debug support') -----
> findSelectorOfMethod: meth forReceiver: rcvr
>
> | currClass done classDict classDictSize methodArray i |
> currClass := objectMemory fetchClassOf: rcvr.
> done := false.
> [done] whileFalse: [
> classDict := objectMemory fetchPointer: MessageDictionaryIndex ofObject: currClass.
> classDictSize := objectMemory fetchWordLengthOf: classDict.
> methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
> i := 0.
> [i <= (classDictSize - SelectorStart)] whileTrue: [
> meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: [
> ^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)
> ].
> i := i + 1.
> ].
> currClass := objectMemory fetchPointer: SuperclassIndex ofObject: currClass.
> + done := currClass = objectMemory getNilObj.
> - done := currClass = objectMemory nilObj.
> ].
> + ^ objectMemory getNilObj "method not found in superclass chain"!
> - ^ objectMemory nilObj "method not found in superclass chain"!
>
> Item was changed:
> ----- Method: Interpreter>>flushExternalPrimitives (in category 'plugin primitive support') -----
> flushExternalPrimitives
> "Flush the references to external functions from plugin
> primitives. This will force a reload of those primitives when
> accessed next.
> Note: We must flush the method cache here so that any
> failed primitives are looked up again."
> | oop primIdx |
> oop := objectMemory firstObject.
> + [objectMemory oop: oop isLessThan: objectMemory getEndOfMemory]
> - [objectMemory oop: oop isLessThan: objectMemory endOfMemory]
> whileTrue: [(objectMemory isFreeObject: oop)
> ifFalse: [(objectMemory isCompiledMethod: oop)
> ifTrue: ["This is a compiled method"
> primIdx := self primitiveIndexOf: oop.
> primIdx = PrimitiveExternalCallIndex
> ifTrue: ["It's primitiveExternalCall"
> self flushExternalPrimitiveOf: oop]]].
> oop := objectMemory objectAfter: oop].
> self flushMethodCache.
> self flushExternalPrimitiveTable!
>
> Item was removed:
> - ----- Method: Interpreter>>imageFormatInitialVersion (in category 'image save/restore') -----
> - imageFormatInitialVersion
> - "This is the image format version that was saved to in the previous image snapshot.
> - The interpreter checks this value at image load time to determine if it is able to load
> - and run the image file. When the image is next saved, it will be saved using the current
> - imageFormatVersion, which may be different from imageFormatInitialVersion. "
> - ^imageFormatInitialVersion!
>
> Item was changed:
> ----- Method: Interpreter>>includesBehavior:ThatOf: (in category 'plugin primitive support') -----
> includesBehavior: aClass ThatOf: aSuperclass
> "Return the equivalent of
> aClass includesBehavior: aSuperclass.
> Note: written for efficiency and better inlining (only 1 temp)"
> | theClass |
> <inline: true>
> + aSuperclass = objectMemory getNilObj ifTrue:
> - aSuperclass = objectMemory nilObj ifTrue:
> [^false].
> theClass := aClass.
> [theClass = aSuperclass ifTrue:
> [^true].
> + theClass ~= objectMemory getNilObj] whileTrue:
> - theClass ~= objectMemory nilObj] whileTrue:
> [theClass := self superclassOf: theClass].
> ^false!
>
> Item was added:
> + ----- Method: Interpreter>>initialImageFormatVersion (in category 'image save/restore') -----
> + initialImageFormatVersion
> + "This is the image format version that was saved to in the previous image snapshot.
> + The interpreter checks this value at image load time to determine if it is able to load
> + and run the image file. When the image is next saved, it will be saved using the current
> + imageFormatVersion, which may be different from imageFormatInitialVersion.
> + Selector name chosen to avoid conflict with variable declaration in generated code."
> + ^imageFormatInitialVersion!
>
> Item was changed:
> ----- Method: Interpreter>>initializeInterpreter: (in category 'initialization') -----
> initializeInterpreter: bytesToShift
> "Initialize Interpreter state before starting execution of a new image."
> interpreterProxy := self sqGetInterpreterProxy.
> self dummyReferToProxy.
> objectMemory initializeObjectMemory: bytesToShift.
> self initCompilerHooks.
> + activeContext := objectMemory getNilObj.
> + theHomeContext := objectMemory getNilObj.
> + method := objectMemory getNilObj.
> + receiver := objectMemory getNilObj.
> + messageSelector := objectMemory getNilObj.
> + newMethod := objectMemory getNilObj.
> + methodClass := objectMemory getNilObj.
> + lkupClass := objectMemory getNilObj.
> + receiverClass := objectMemory getNilObj.
> + newNativeMethod := objectMemory getNilObj.
> - activeContext := objectMemory nilObj.
> - theHomeContext := objectMemory nilObj.
> - method := objectMemory nilObj.
> - receiver := objectMemory nilObj.
> - messageSelector := objectMemory nilObj.
> - newMethod := objectMemory nilObj.
> - methodClass := objectMemory nilObj.
> - lkupClass := objectMemory nilObj.
> - receiverClass := objectMemory nilObj.
> - newNativeMethod := objectMemory nilObj.
> self flushMethodCache.
> self loadInitialContext.
> self initialCleanup.
> interruptCheckCounter := 0.
> interruptCheckCounterFeedBackReset := 1000.
> interruptChecksEveryNms := 1.
> nextPollTick := 0.
> nextWakeupTick := 0.
> lastTick := 0.
> interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
> interruptPending := false.
> semaphoresUseBufferA := true.
> semaphoresToSignalCountA := 0.
> semaphoresToSignalCountB := 0.
> deferDisplayUpdates := false.
> pendingFinalizationSignals := 0.
> globalSessionID := 0.
> [globalSessionID = 0]
> whileTrue: [globalSessionID := self
> cCode: 'time(NULL) + ioMSecs()'
> inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
> jmpDepth := 0.
> jmpMax := MaxJumpBuf. "xxxx: Must match the definition of jmpBuf and suspendedCallbacks"
> !
>
> Item was changed:
> ----- Method: Interpreter>>internalActivateNewMethod (in category 'message sending') -----
> internalActivateNewMethod
> | methodHeader newContext tempCount argCount2 needsLarge where |
> <inline: true>
>
> methodHeader := self headerOf: newMethod.
> needsLarge := methodHeader bitAnd: LargeContextBit.
> + (needsLarge = 0 and: [objectMemory getFreeContexts ~= objectMemory nilContext])
> + ifTrue: [newContext := objectMemory getFreeContexts.
> - (needsLarge = 0 and: [objectMemory freeContexts ~= objectMemory nilContext])
> - ifTrue: [newContext := objectMemory freeContexts.
> objectMemory setFreeContextsAfter: newContext]
> ifFalse: ["Slower call for large contexts or empty free list"
> self externalizeIPandSP.
> newContext := objectMemory allocateOrRecycleContext: needsLarge.
> self internalizeIPandSP].
> tempCount := (methodHeader >> 19) bitAnd: 16r3F.
>
> "Assume: newContext will be recorded as a root if necessary by the
> call to newActiveContext: below, so we can use unchecked stores."
> where := newContext + objectMemory baseHeaderSize.
> objectMemory longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
> objectMemory longAt: where + (InstructionPointerIndex << objectMemory shiftForWord)
> put: (objectMemory integerObjectOf: (((LiteralStart + (self literalCountOfHeader: methodHeader)) * objectMemory bytesPerWord) + 1)).
> objectMemory longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
> objectMemory longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
> + objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory getNilObj.
> - objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory nilObj.
>
> "Copy the receiver and arguments..."
> argCount2 := argumentCount.
> 0 to: argCount2 do:
> [:i | objectMemory longAt: where + ((ReceiverIndex+i) << objectMemory shiftForWord) put: (self internalStackValue: argCount2-i)].
>
> "clear remaining temps to nil in case it has been recycled"
> + methodHeader := objectMemory getNilObj. "methodHeader here used just as faster (register?) temp"
> - methodHeader := objectMemory nilObj. "methodHeader here used just as faster (register?) temp"
> argCount2+1+ReceiverIndex to: tempCount+ReceiverIndex do:
> [:i | objectMemory longAt: where + (i << objectMemory shiftForWord) put: methodHeader].
>
> self internalPop: argCount2 + 1.
> reclaimableContextCount := reclaimableContextCount + 1.
> self internalNewActiveContext: newContext.
> !
>
> Item was changed:
> ----- Method: Interpreter>>internalExecuteNewMethod (in category 'message sending') -----
> internalExecuteNewMethod
> | localPrimIndex delta nArgs |
> <inline: true>
> localPrimIndex := primitiveIndex.
> localPrimIndex > 0
> ifTrue: [(localPrimIndex > 255
> and: [localPrimIndex < 520])
> ifTrue: ["Internal return instvars"
> localPrimIndex >= 264
> ifTrue: [^ self internalPop: 1 thenPush: (objectMemory fetchPointer: localPrimIndex - 264 ofObject: self internalStackTop)]
> ifFalse: ["Internal return constants"
> localPrimIndex = 256 ifTrue: [^ nil].
> + localPrimIndex = 257 ifTrue: [^ self internalPop: 1 thenPush: objectMemory getTrueObj].
> + localPrimIndex = 258 ifTrue: [^ self internalPop: 1 thenPush: objectMemory getFalseObj].
> + localPrimIndex = 259 ifTrue: [^ self internalPop: 1 thenPush: objectMemory getNilObj].
> - localPrimIndex = 257 ifTrue: [^ self internalPop: 1 thenPush: objectMemory trueObj].
> - localPrimIndex = 258 ifTrue: [^ self internalPop: 1 thenPush: objectMemory falseObj].
> - localPrimIndex = 259 ifTrue: [^ self internalPop: 1 thenPush: objectMemory nilObj].
> ^ self internalPop: 1 thenPush: (objectMemory integerObjectOf: localPrimIndex - 261)]]
> ifFalse: [self externalizeIPandSP.
> "self primitiveResponse. <-replaced with manually inlined code"
> DoBalanceChecks
> ifTrue: ["check stack balance"
> nArgs := argumentCount.
> delta := stackPointer - activeContext].
> self initPrimCall.
> self dispatchFunctionPointer: primitiveFunctionPointer. "branch direct to prim function from address stored in mcache"
> DoBalanceChecks
> ifTrue: [(self balancedStack: delta afterPrimitive: localPrimIndex withArgs: nArgs)
> ifFalse: [self printUnbalancedStack: localPrimIndex]].
> self internalizeIPandSP.
> self successful
> ifTrue: [self browserPluginReturnIfNeeded.
> ^ nil]]].
> "if not primitive, or primitive failed, activate the method"
> self internalActivateNewMethod.
> "check for possible interrupts at each real send"
> self internalQuickCheckForInterrupts!
>
> Item was changed:
> ----- Method: Interpreter>>internalFetchContextRegisters: (in category 'contexts') -----
> internalFetchContextRegisters: activeCntx
> "Inlined into return bytecodes. The only difference between this method and fetchContextRegisters: is that this method sets the local IP and SP."
>
> | tmp |
> <inline: true>
> tmp := objectMemory fetchPointer: MethodIndex ofObject: activeCntx.
> (objectMemory isIntegerObject: tmp) ifTrue: [
> "if the MethodIndex field is an integer, activeCntx is a block context"
> tmp := objectMemory fetchPointer: HomeIndex ofObject: activeCntx.
> + (objectMemory oop: tmp isLessThan: objectMemory getYoungStart) ifTrue: [ objectMemory beRootIfOld: tmp ].
> - (objectMemory oop: tmp isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: tmp ].
> ] ifFalse: [
> "otherwise, it is a method context and is its own home context"
> tmp := activeCntx.
> ].
> localHomeContext := tmp.
> receiver := objectMemory fetchPointer: ReceiverIndex ofObject: tmp.
> method := objectMemory fetchPointer: MethodIndex ofObject: tmp.
>
> "the instruction pointer is a pointer variable equal to
> method oop + ip + objectMemory baseHeaderSize
> -1 for 0-based addressing of fetchByte
> -1 because it gets incremented BEFORE fetching currentByte"
> tmp := self quickFetchInteger: InstructionPointerIndex ofObject: activeCntx.
> localIP := objectMemory pointerForOop: method + tmp + objectMemory baseHeaderSize - 2.
>
> "the stack pointer is a pointer variable also..."
> tmp := self quickFetchInteger: StackPointerIndex ofObject: activeCntx.
> localSP := objectMemory pointerForOop: activeCntx + objectMemory baseHeaderSize + ((TempFrameStart + tmp - 1) * objectMemory bytesPerWord)!
>
> Item was changed:
> ----- Method: Interpreter>>internalJustActivateNewMethod (in category 'message sending') -----
> internalJustActivateNewMethod
> "Activate the new method but *do not* copy receiver or arguments from activeContext."
> | methodHeader initialIP newContext tempCount needsLarge where |
> <inline: true>
>
> methodHeader := self headerOf: newMethod.
> needsLarge := methodHeader bitAnd: LargeContextBit.
> + (needsLarge = 0 and: [objectMemory getFreeContexts ~= objectMemory nilContext])
> + ifTrue: [newContext := objectMemory getFreeContexts.
> - (needsLarge = 0 and: [objectMemory freeContexts ~= objectMemory nilContext])
> - ifTrue: [newContext := objectMemory freeContexts.
> objectMemory setFreeContextsAfter: newContext]
> ifFalse: ["Slower call for large contexts or empty free list"
> newContext := objectMemory allocateOrRecycleContext: needsLarge].
> initialIP := ((LiteralStart + (self literalCountOfHeader: methodHeader)) * objectMemory bytesPerWord) + 1.
> tempCount := (methodHeader >> 19) bitAnd: 16r3F.
>
> "Assume: newContext will be recorded as a root if necessary by the
> call to newActiveContext: below, so we can use unchecked stores."
> where := newContext + objectMemory baseHeaderSize.
> objectMemory longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
> objectMemory longAt: where + (InstructionPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: initialIP).
> objectMemory longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
> objectMemory longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
>
> "Set the receiver..."
> objectMemory longAt: where + (ReceiverIndex << objectMemory shiftForWord) put: receiver.
>
> "clear all args and temps to nil in case it has been recycled"
> + needsLarge := objectMemory getNilObj. "needsLarge here used just as faster (register?) temp"
> - needsLarge := objectMemory nilObj. "needsLarge here used just as faster (register?) temp"
> ReceiverIndex + 1 to: tempCount + ReceiverIndex do:
> [:i | objectMemory longAt: where + (i << objectMemory shiftForWord) put: needsLarge].
> reclaimableContextCount := reclaimableContextCount + 1.
>
> activeContext := newContext.!
>
> Item was changed:
> ----- Method: Interpreter>>internalNewActiveContext: (in category 'contexts') -----
> internalNewActiveContext: aContext
> "The only difference between this method and newActiveContext: is that this method uses internal context registers."
> <inline: true>
>
> self internalStoreContextRegisters: activeContext.
> + (objectMemory oop: aContext isLessThan: objectMemory getYoungStart) ifTrue: [ objectMemory beRootIfOld: aContext ].
> - (objectMemory oop: aContext isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: aContext ].
> activeContext := aContext.
> self internalFetchContextRegisters: aContext.!
>
> Item was changed:
> ----- Method: Interpreter>>internalPrimitiveValue (in category 'control primitives') -----
> internalPrimitiveValue
> | newContext blockArgumentCount initialIP |
> <inline: true>
> self sharedCodeNamed: 'commonPrimitiveValue' inCase: 201.
> self initPrimCall.
> newContext := self internalStackValue: argumentCount.
> self assertClassOf: newContext is: (objectMemory splObj: ClassBlockContext).
> blockArgumentCount := self argumentCountOfBlock: newContext.
>
> + self success: (argumentCount = blockArgumentCount and: [(objectMemory fetchPointer: CallerIndex ofObject: newContext) = objectMemory getNilObj]).
> - self success: (argumentCount = blockArgumentCount and: [(objectMemory fetchPointer: CallerIndex ofObject: newContext) = objectMemory nilObj]).
>
> self successful
> ifTrue: ["This code assumes argCount can only = 0 or 1"
> argumentCount = 1
> ifTrue: [objectMemory storePointer: TempFrameStart ofObject: newContext withValue: self internalStackTop].
> self internalPop: argumentCount + 1.
> "copy the initialIP value to the ip slot"
> initialIP := objectMemory fetchPointer: InitialIPIndex ofObject: newContext.
> objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: newContext withValue: initialIP.
> self storeStackPointerValue: argumentCount inContext: newContext.
> objectMemory storePointerUnchecked: CallerIndex ofObject: newContext withValue: activeContext.
> self internalNewActiveContext: newContext]
> ifFalse: [messageSelector := self specialSelector: 25 + argumentCount.
> self normalSend]!
>
> Item was changed:
> ----- Method: Interpreter>>is:KindOf: (in category 'plugin primitive support') -----
> is: oop KindOf: className
> "Support for external primitives."
> | oopClass |
> <var: #className type: 'char *'>
> oopClass := objectMemory fetchClassOf: oop.
> + [oopClass == objectMemory getNilObj] whileFalse:[
> - [oopClass == objectMemory nilObj] whileFalse:[
> (self classNameOf: oopClass Is: className) ifTrue:[^true].
> oopClass := self superclassOf: oopClass].
> ^false!
>
> Item was changed:
> ----- Method: Interpreter>>is:KindOfClass: (in category 'plugin primitive support') -----
> is: oop KindOfClass: aClass
> "Support for external primitives."
> <api>
> | oopClass |
> oopClass := self fetchClassOf: oop.
> + [oopClass = objectMemory getNilObj] whileFalse:
> - [oopClass = objectMemory nilObj] whileFalse:
> [oopClass = aClass ifTrue: [^true].
> oopClass := self superclassOf: oopClass].
> ^false!
>
> Item was changed:
> ----- Method: Interpreter>>isEmptyList: (in category 'process primitive support') -----
> isEmptyList: aLinkedList
>
> + ^ (objectMemory fetchPointer: FirstLinkIndex ofObject: aLinkedList) = objectMemory getNilObj!
> - ^ (objectMemory fetchPointer: FirstLinkIndex ofObject: aLinkedList) = objectMemory nilObj!
>
> Item was changed:
> ----- Method: Interpreter>>jumplfFalseBy: (in category 'jump bytecodes') -----
> jumplfFalseBy: offset
> | boolean |
> boolean := self internalStackTop.
> + boolean = objectMemory getFalseObj
> - boolean = objectMemory falseObj
> ifTrue: [self jump: offset]
> + ifFalse: [boolean = objectMemory getTrueObj
> - ifFalse: [boolean = objectMemory trueObj
> ifFalse: [messageSelector := objectMemory splObj: SelectorMustBeBoolean.
> argumentCount := 0.
> ^ self normalSend].
> self fetchNextBytecode].
> self internalPop: 1!
>
> Item was changed:
> ----- Method: Interpreter>>jumplfTrueBy: (in category 'jump bytecodes') -----
> jumplfTrueBy: offset
> | boolean |
> boolean := self internalStackTop.
> + boolean = objectMemory getTrueObj
> - boolean = objectMemory trueObj
> ifTrue: [self jump: offset]
> + ifFalse: [boolean = objectMemory getFalseObj
> - ifFalse: [boolean = objectMemory falseObj
> ifFalse: [messageSelector := objectMemory splObj: SelectorMustBeBoolean.
> argumentCount := 0.
> ^ self normalSend].
> self fetchNextBytecode].
> self internalPop: 1!
>
> Item was changed:
> ----- Method: Interpreter>>loadInitialContext (in category 'initialization') -----
> loadInitialContext
>
> | sched proc |
> sched := objectMemory fetchPointer: ValueIndex ofObject: (objectMemory splObj: SchedulerAssociation).
> proc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
> activeContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: proc.
> + (objectMemory oop: activeContext isLessThan: objectMemory getYoungStart) ifTrue: [ objectMemory beRootIfOld: activeContext ].
> - (objectMemory oop: activeContext isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: activeContext ].
> self fetchContextRegisters: activeContext.
> reclaimableContextCount := 0.!
>
> Item was changed:
> ----- Method: Interpreter>>lookupMethodInClass: (in category 'message sending') -----
> lookupMethodInClass: class
> | currentClass dictionary found rclass |
> <inline: false>
>
> currentClass := class.
> + [currentClass ~= objectMemory getNilObj]
> - [currentClass ~= objectMemory nilObj]
> whileTrue:
> [dictionary := objectMemory fetchPointer: MessageDictionaryIndex ofObject: currentClass.
> + dictionary = objectMemory getNilObj ifTrue:
> - dictionary = objectMemory nilObj ifTrue:
> ["MethodDict pointer is nil (hopefully due a swapped out stub)
> -- raise exception #cannotInterpret:."
> objectMemory pushRemappableOop: currentClass. "may cause GC!!"
> self createActualMessageTo: class.
> currentClass := objectMemory popRemappableOop.
> messageSelector := objectMemory splObj: SelectorCannotInterpret.
> ^ self lookupMethodInClass: (self superclassOf: currentClass)].
> found := self lookupMethodInDictionary: dictionary.
> found ifTrue: [^ methodClass := currentClass].
> currentClass := self superclassOf: currentClass].
>
> "Could not find #doesNotUnderstand: -- unrecoverable error."
> messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue:
> [self error: 'Recursive not understood error encountered'].
>
> "Cound not find a normal message -- raise exception #doesNotUnderstand:"
> objectMemory pushRemappableOop: class. "may cause GC!!"
> self createActualMessageTo: class.
> rclass := objectMemory popRemappableOop.
> messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
> ^ self lookupMethodInClass: rclass!
>
> Item was changed:
> ----- Method: Interpreter>>lookupMethodInDictionary: (in category 'message sending') -----
> lookupMethodInDictionary: dictionary
> "This method lookup tolerates integers as Dictionary keys to
> support execution of images in which Symbols have been
> compacted out"
> | length index mask wrapAround nextSelector methodArray |
> <inline: true>
> length := objectMemory fetchWordLengthOf: dictionary.
> mask := length - SelectorStart - 1.
> (objectMemory isIntegerObject: messageSelector)
> ifTrue: [index := (mask bitAnd: (objectMemory integerValueOf: messageSelector)) + SelectorStart]
> ifFalse: [index := (mask bitAnd: (objectMemory hashBitsOf: messageSelector)) + SelectorStart].
>
> "It is assumed that there are some nils in this dictionary, and search will
> stop when one is encountered. However, if there are no nils, then wrapAround
> will be detected the second time the loop gets to the end of the table."
> wrapAround := false.
> [true]
> whileTrue: [nextSelector := objectMemory fetchPointer: index ofObject: dictionary.
> + nextSelector = objectMemory getNilObj ifTrue: [^ false].
> - nextSelector = objectMemory nilObj ifTrue: [^ false].
> nextSelector = messageSelector
> ifTrue: [methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
> newMethod := objectMemory fetchPointer: index - SelectorStart ofObject: methodArray.
> "Check if newMethod is a CompiledMethod."
> (objectMemory isCompiledMethod: newMethod)
> ifTrue: [primitiveIndex := self primitiveIndexOf: newMethod.
> primitiveIndex > MaxPrimitiveIndex
> ifTrue: ["If primitiveIndex is out of range, set to zero before putting in
> cache. This is equiv to primFail, and avoids the need to check on
> every send."
> primitiveIndex := 0]]
> ifFalse: ["indicate that this is no compiled method - use primitiveInvokeObjectAsMethod"
> primitiveIndex := 248].
> ^ true].
> index := index + 1.
> index = length
> ifTrue: [wrapAround
> ifTrue: [^ false].
> wrapAround := true.
> index := SelectorStart]]!
>
> Item was changed:
> ----- Method: Interpreter>>lookupMethodNoMNUEtcInClass: (in category 'alien support') -----
> lookupMethodNoMNUEtcInClass: class
> "Lookup. Answer false on failure father than performing MNU processing etc."
> | currentClass dictionary |
> <inline: true>
>
> currentClass := class.
> + [currentClass ~= objectMemory getNilObj] whileTrue:
> - [currentClass ~= objectMemory nilObj] whileTrue:
> [dictionary := objectMemory fetchPointer: MessageDictionaryIndex ofObject: currentClass.
> + (dictionary ~= objectMemory getNilObj
> - (dictionary ~= objectMemory nilObj
> and: [self lookupMethodInDictionary: dictionary]) ifTrue:
> [methodClass := currentClass.
> ^true].
> currentClass := self superclassOf: currentClass].
>
> ^false!
>
> Item was changed:
> ----- Method: Interpreter>>mapInterpreterOops (in category 'object memory support') -----
> mapInterpreterOops
> "Map all oops in the interpreter's state to their new values
> during garbage collection or a become: operation."
> "Assume: All traced variables contain valid oops."
> | oop |
> objectMemory mapRootObjects.
> compilerInitialized
> ifFalse: [stackPointer := stackPointer - activeContext. "*rel to active"
> activeContext := objectMemory remap: activeContext.
> stackPointer := stackPointer + activeContext. "*rel to active"
> theHomeContext := objectMemory remap: theHomeContext].
> instructionPointer := instructionPointer - method. "*rel to method"
> method := objectMemory remap: method.
> instructionPointer := instructionPointer + method. "*rel to method"
> receiver := objectMemory remap: receiver.
> messageSelector := objectMemory remap: messageSelector.
> newMethod := objectMemory remap: newMethod.
> methodClass := objectMemory remap: methodClass.
> lkupClass := objectMemory remap: lkupClass.
> receiverClass := objectMemory remap: receiverClass.
> + 1 to: objectMemory getRemapBufferCount do: [:i |
> + oop := objectMemory remapBufferAt: i.
> - 1 to: objectMemory remapBufferCount do: [:i |
> - oop := objectMemory remapBuffer at: i.
> (objectMemory isIntegerObject: oop)
> + ifFalse: [objectMemory remapBufferAt: i put: (objectMemory remap: oop)]].
> - ifFalse: [objectMemory remapBuffer at: i put: (objectMemory remap: oop)]].
>
> "Callback support - trace suspended callback list"
> 1 to: jmpDepth do:[:i|
> oop := suspendedCallbacks at: i.
> (objectMemory isIntegerObject: oop)
> ifFalse:[suspendedCallbacks at: i put: (objectMemory remap: oop)].
> oop := suspendedMethods at: i.
> (objectMemory isIntegerObject: oop)
> ifFalse:[suspendedMethods at: i put: (objectMemory remap: oop)].
> ].
> !
>
> Item was removed:
> - ----- Method: Interpreter>>markAndTraceInterpreterOops (in category 'object memory support') -----
> - markAndTraceInterpreterOops
> - "Mark and trace all oops in the interpreter's state."
> - "Assume: All traced variables contain valid oops."
> - | oop |
> - self compilerMarkHook.
> - objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
> - compilerInitialized
> - ifTrue: [objectMemory markAndTrace: receiver.
> - objectMemory markAndTrace: method]
> - ifFalse: [objectMemory markAndTrace: activeContext].
> - objectMemory markAndTrace: messageSelector.
> - objectMemory markAndTrace: newMethod.
> - objectMemory markAndTrace: methodClass.
> - objectMemory markAndTrace: lkupClass.
> - objectMemory markAndTrace: receiverClass.
> - 1 to: objectMemory remapBufferCount do: [:i |
> - oop := objectMemory remapBuffer at: i.
> - (objectMemory isIntegerObject: oop) ifFalse: [objectMemory markAndTrace: oop]].
> -
> - "Callback support - trace suspended callback list"
> - 1 to: jmpDepth do:[:i|
> - oop := suspendedCallbacks at: i.
> - (objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
> - oop := suspendedMethods at: i.
> - (objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
> - ].
> - !
>
> Item was changed:
> ----- Method: Interpreter>>markAndTraceInterpreterOops: (in category 'object memory support') -----
> markAndTraceInterpreterOops: fullGCFlag
> + "Mark and trace all oops in the interpreter's state."
> + "Assume: All traced variables contain valid oops."
> + | oop |
> + self compilerMarkHook.
> + objectMemory markAndTrace: objectMemory getSpecialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
> + compilerInitialized
> + ifTrue: [objectMemory markAndTrace: receiver.
> + objectMemory markAndTrace: method]
> + ifFalse: [objectMemory markAndTrace: activeContext].
> + objectMemory markAndTrace: messageSelector.
> + objectMemory markAndTrace: newMethod.
> + objectMemory markAndTrace: methodClass.
> + objectMemory markAndTrace: lkupClass.
> + objectMemory markAndTrace: receiverClass.
> + 1 to: objectMemory getRemapBufferCount do: [:i |
> + oop := objectMemory remapBufferAt: i.
> + (objectMemory isIntegerObject: oop) ifFalse: [objectMemory markAndTrace: oop]].
> +
> + "Callback support - trace suspended callback list"
> + 1 to: jmpDepth do:[:i|
> + oop := suspendedCallbacks at: i.
> + (objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
> + oop := suspendedMethods at: i.
> + (objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
> + ].
> - "Compatibility with NewObjectMemory"
> - ^self markAndTraceInterpreterOops
> !
>
> Item was changed:
> ----- Method: Interpreter>>newActiveContext: (in category 'contexts') -----
> newActiveContext: aContext
> "Note: internalNewActiveContext: should track changes to this method."
>
> self storeContextRegisters: activeContext.
> + (objectMemory oop: aContext isLessThan: objectMemory getYoungStart) ifTrue: [ objectMemory beRootIfOld: aContext ].
> - (objectMemory oop: aContext isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: aContext ].
> activeContext := aContext.
> self fetchContextRegisters: aContext.!
>
> Item was changed:
> ----- Method: Interpreter>>okayActiveProcessStack (in category 'debug support') -----
> okayActiveProcessStack
>
> | cntxt |
> cntxt := activeContext.
> + [cntxt = objectMemory getNilObj] whileFalse: [
> - [cntxt = objectMemory nilObj] whileFalse: [
> self okayFields: cntxt.
> cntxt := (objectMemory fetchPointer: SenderIndex ofObject: cntxt).
> ].!
>
> Item was changed:
> ----- Method: Interpreter>>okayInterpreterObjects (in category 'debug support') -----
> okayInterpreterObjects
>
> | oopOrZero oop |
> + self okayFields: objectMemory getNilObj.
> + self okayFields: objectMemory getFalseObj.
> + self okayFields: objectMemory getTrueObj.
> + self okayFields: objectMemory getSpecialObjectsOop.
> - self okayFields: objectMemory nilObj.
> - self okayFields: objectMemory falseObj.
> - self okayFields: objectMemory trueObj.
> - self okayFields: objectMemory specialObjectsOop.
> self okayFields: activeContext.
> self okayFields: method.
> self okayFields: receiver.
> self okayFields: theHomeContext.
> self okayFields: messageSelector.
> self okayFields: newMethod.
> self okayFields: lkupClass.
> 0 to: MethodCacheEntries - 1 by: MethodCacheEntrySize do: [ :i |
> oopOrZero := methodCache at: i + MethodCacheSelector.
> oopOrZero = 0 ifFalse: [
> self okayFields: (methodCache at: i + MethodCacheSelector).
> self okayFields: (methodCache at: i + MethodCacheClass).
> self okayFields: (methodCache at: i + MethodCacheMethod).
> ].
> ].
> + 1 to: objectMemory getRemapBufferCount do: [ :i |
> + oop := objectMemory remapBufferAt: i.
> - 1 to: objectMemory remapBufferCount do: [ :i |
> - oop := objectMemory remapBuffer at: i.
> (objectMemory isIntegerObject: oop) ifFalse: [
> self okayFields: oop.
> ].
> ].
> self okayActiveProcessStack.!
>
> Item was changed:
> ----- Method: Interpreter>>pop:thenPushBool: (in category 'contexts') -----
> pop: nItems thenPushBool: trueOrFalse
> "A few places pop a few items off the stack and then push a boolean. Make it convenient"
> | sp |
> objectMemory longAt: (sp := stackPointer - ((nItems - 1) * objectMemory bytesPerWord))
> + put:(trueOrFalse ifTrue: [objectMemory getTrueObj] ifFalse: [objectMemory getFalseObj]).
> - put:(trueOrFalse ifTrue: [objectMemory trueObj] ifFalse: [objectMemory falseObj]).
> stackPointer := sp!
>
> Item was changed:
> ----- Method: Interpreter>>postGCAction (in category 'object memory support') -----
> postGCAction
> "Mark the active and home contexts as roots if old. This
> allows the interpreter to use storePointerUnchecked to
> store into them."
>
> compilerInitialized
> ifTrue: [self compilerPostGC]
> + ifFalse: [(objectMemory oop: activeContext isLessThan: objectMemory getYoungStart)
> - ifFalse: [(objectMemory oop: activeContext isLessThan: objectMemory youngStart)
> ifTrue: [objectMemory beRootIfOld: activeContext].
> + (objectMemory oop: theHomeContext isLessThan: objectMemory getYoungStart)
> - (objectMemory oop: theHomeContext isLessThan: objectMemory youngStart)
> ifTrue: [objectMemory beRootIfOld: theHomeContext]].
> + (objectMemory oop: (objectMemory sizeOfFree: objectMemory getFreeBlock) isGreaterThan: objectMemory getShrinkThreshold)
> - (objectMemory oop: (objectMemory sizeOfFree: objectMemory freeBlock) isGreaterThan: objectMemory shrinkThreshold)
> ifTrue: ["Attempt to shrink memory after successfully
> reclaiming lots of memory"
> + objectMemory shrinkObjectMemory: (objectMemory sizeOfFree: objectMemory getFreeBlock) - objectMemory getGrowHeadroom].
> - objectMemory shrinkObjectMemory: (objectMemory sizeOfFree: objectMemory freeBlock) - objectMemory growHeadroom].
>
> + self signalSemaphoreWithIndex: objectMemory getGcSemaphoreIndex.
> - self signalSemaphoreWithIndex: objectMemory gcSemaphoreIndex.
> !
>
> Item was changed:
> ----- Method: Interpreter>>primitiveBlockCopy (in category 'control primitives') -----
> primitiveBlockCopy
>
> | context methodContext contextSize newContext initialIP |
> context := self stackValue: 1.
> (objectMemory isIntegerObject: (objectMemory fetchPointer: MethodIndex ofObject: context))
> ifTrue: ["context is a block; get the context of its enclosing method"
> methodContext := objectMemory fetchPointer: HomeIndex ofObject: context]
> ifFalse: [methodContext := context].
> contextSize := objectMemory sizeBitsOf: methodContext. "in bytes, including header"
> context := nil. "context is no longer needed and is not preserved across allocation"
>
> "remap methodContext in case GC happens during allocation"
> objectMemory pushRemappableOop: methodContext.
> newContext := objectMemory instantiateContext: (objectMemory splObj: ClassBlockContext) sizeInBytes: contextSize.
> methodContext := objectMemory popRemappableOop.
>
> initialIP := objectMemory integerObjectOf: (instructionPointer+1+3) - (method + objectMemory baseHeaderSize).
> "Was instructionPointer + 3, but now it's greater by 1 due to preIncrement"
>
> "Assume: have just allocated a new context; it must be young.
> Thus, can use uncheck stores. See the comment in fetchContextRegisters."
>
> objectMemory storePointerUnchecked: InitialIPIndex ofObject: newContext withValue: initialIP.
> objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: newContext withValue: initialIP.
> self storeStackPointerValue: 0 inContext: newContext.
> objectMemory storePointerUnchecked: BlockArgumentCountIndex ofObject: newContext withValue: (self stackValue: 0).
> objectMemory storePointerUnchecked: HomeIndex ofObject: newContext withValue: methodContext.
> + objectMemory storePointerUnchecked: SenderIndex ofObject: newContext withValue: objectMemory getNilObj.
> - objectMemory storePointerUnchecked: SenderIndex ofObject: newContext withValue: objectMemory nilObj.
>
> self pop: 2 thenPush: newContext.!
>
> Item was changed:
> ----- Method: Interpreter>>primitiveDeferDisplayUpdates (in category 'I/O primitives') -----
> primitiveDeferDisplayUpdates
> "Set or clear the flag that controls whether modifications of
> the Display object are propagated to the underlying
> platform's screen."
> | flag |
> flag := self stackTop.
> + flag = objectMemory getTrueObj
> - flag = objectMemory trueObj
> ifTrue: [deferDisplayUpdates := true]
> + ifFalse: [flag = objectMemory getFalseObj
> - ifFalse: [flag = objectMemory falseObj
> ifTrue: [deferDisplayUpdates := false]
> ifFalse: [self primitiveFail]].
> self successful
> ifTrue: [self pop: 1]!
>
> Item was changed:
> ----- Method: Interpreter>>primitiveDoPrimitiveWithArgs (in category 'control primitives') -----
> primitiveDoPrimitiveWithArgs
> | argumentArray arraySize index cntxSize primIdx |
> argumentArray := self stackTop.
> arraySize := objectMemory fetchWordLengthOf: argumentArray.
> cntxSize := objectMemory fetchWordLengthOf: activeContext.
> self success: self stackPointerIndex + arraySize < cntxSize.
> (objectMemory isArray: argumentArray) ifFalse: [^ self primitiveFail].
>
> primIdx := self stackIntegerValue: 1.
> self successful ifFalse: [^ self primitiveFail]. "invalid args"
>
> "Pop primIndex and argArray, then push args in place..."
> self pop: 2.
> primitiveIndex := primIdx.
> argumentCount := arraySize.
> index := 1.
> [index <= argumentCount]
> whileTrue: [self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
> index := index + 1].
>
> "Run the primitive (sets primFailCode)"
> objectMemory pushRemappableOop: argumentArray. "prim might alloc/gc"
> + lkupClass := objectMemory getNilObj.
> - lkupClass := objectMemory nilObj.
> self primitiveResponse.
> argumentArray := objectMemory popRemappableOop.
> self successful
> ifFalse: ["If primitive failed, then restore state for failure code"
> self pop: arraySize.
> self pushInteger: primIdx.
> self push: argumentArray.
> argumentCount := 2]!
>
> Item was changed:
> ----- Method: Interpreter>>primitiveExternalCall (in category 'plugin primitives') -----
> primitiveExternalCall
> "Call an external primitive. The external primitive methods
> contain as first literal an array consisting of:
> * The module name (String | Symbol)
> * The function name (String | Symbol)
> * The session ID (SmallInteger) [OBSOLETE]
> * The function index (Integer) in the externalPrimitiveTable
> For fast failures the primitive index of any method where the
> external prim is not found is rewritten in the method cache
> with zero. This allows for ultra fast responses as long as the
> method stays in the cache.
> The fast failure response relies on lkupClass being properly
> set. This is done in
> #addToMethodCacheSel:class:method:primIndex: to
> compensate for execution of methods that are looked up in a
> superclass (such as in primitivePerformAt).
> With the latest modifications (e.g., actually flushing the
> function addresses from the VM), the session ID is obsolete.
> But for backward compatibility it is still kept around. Also, a
> failed lookup is reported specially. If a method has been
> looked up and not been found, the function address is stored
> as -1 (e.g., the SmallInteger -1 to distinguish from
> 16rFFFFFFFF which may be returned from the lookup).
> It is absolutely okay to remove the rewrite if we run into any
> problems later on. It has an approximate speed difference of
> 30% per failed primitive call which may be noticable but if,
> for any reasons, we run into problems (like with J3) we can
> always remove the rewrite.
> "
> | lit extFnAddr moduleName functionName moduleLength functionLength index |
> <var: #extFnAddr declareC: 'void (*extFnAddr)(void)'>
>
> "Fetch the first literal of the method"
> self success: (self literalCountOf: newMethod) > 0. "@@: Could this be omitted for speed?!!"
> self successful ifFalse: [^ nil].
>
> lit := self literal: 0 ofMethod: newMethod.
> "Check if it's an array of length 4"
> self success: ((objectMemory isArray: lit) and: [(objectMemory lengthOf: lit) = 4]).
> self successful ifFalse: [^ nil].
>
> "Look at the function index in case it has been loaded before"
> index := objectMemory fetchPointer: 3 ofObject: lit.
> index := self checkedIntegerValueOf: index.
> self successful ifFalse: [^ nil].
> "Check if we have already looked up the function and failed."
> index < 0
> ifTrue: ["Function address was not found in this session,
> Rewrite the mcache entry with a zero primitive index."
> self
> rewriteMethodCacheSel: messageSelector
> class: lkupClass
> primIndex: 0.
> ^ self success: false].
>
> "Try to call the function directly"
> (index > 0 and: [index <= MaxExternalPrimitiveTableSize])
> ifTrue: [extFnAddr := externalPrimitiveTable at: index - 1.
> extFnAddr ~= 0
> ifTrue: [self rewriteMethodCacheSel: messageSelector class: lkupClass primIndex: (1000 + index) primFunction: extFnAddr.
> self callExternalPrimitive: extFnAddr.
> ^ nil].
> "if we get here, then an index to the external prim was
> kept on the ST side although the underlying prim
> table was already flushed"
> ^ self primitiveFail].
>
> "Clean up session id and external primitive index"
> objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero.
> objectMemory storePointerUnchecked: 3 ofObject: lit withValue: ConstZero.
>
> "The function has not been loaded yet. Fetch module and function name."
> moduleName := objectMemory fetchPointer: 0 ofObject: lit.
> + moduleName = objectMemory getNilObj
> - moduleName = objectMemory nilObj
> ifTrue: [moduleLength := 0]
> ifFalse: [self success: (objectMemory isBytes: moduleName).
> moduleLength := objectMemory lengthOf: moduleName.
> self cCode: '' inSmalltalk:
> [ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName))
> ifTrue: [moduleLength := 0 "Cause all of these to fail"]]].
> functionName := objectMemory fetchPointer: 1 ofObject: lit.
> self success: (objectMemory isBytes: functionName).
> functionLength := objectMemory lengthOf: functionName.
> self successful ifFalse: [^ nil].
>
> extFnAddr := self cCoerce: (self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
> OfLength: functionLength
> FromModule: moduleName + objectMemory baseHeaderSize
> OfLength: moduleLength) to: 'void (*)(void)'.
> extFnAddr = 0
> ifTrue: [index := -1]
> ifFalse: ["add the function to the external primitive table"
> index := self addToExternalPrimitiveTable: extFnAddr].
> self success: index >= 0.
> "Store the index (or -1 if failure) back in the literal"
> objectMemory storePointerUnchecked: 3 ofObject: lit withValue: (objectMemory integerObjectOf: index).
>
> "If the function has been successfully loaded process it"
> (self successful and: [extFnAddr ~= 0])
> ifTrue: [self rewriteMethodCacheSel: messageSelector class: lkupClass primIndex: (1000 + index) primFunction: extFnAddr.
> self callExternalPrimitive: extFnAddr]
> ifFalse: ["Otherwise rewrite the primitive index"
> self
> rewriteMethodCacheSel: messageSelector
> class: lkupClass
> primIndex: 0]!
>
> Item was changed:
> ----- Method: Interpreter>>primitivePerformInSuperclass (in category 'control primitives') -----
> primitivePerformInSuperclass
> | lookupClass rcvr currentClass |
> lookupClass := self stackTop.
> rcvr := self stackValue: 3.
> currentClass := objectMemory fetchClassOf: rcvr.
> [currentClass ~= lookupClass]
> whileTrue:
> [currentClass := self superclassOf: currentClass.
> + currentClass = objectMemory getNilObj ifTrue: [^self primitiveFailFor: PrimErrBadArgument]].
> - currentClass = objectMemory nilObj ifTrue: [^self primitiveFailFor: PrimErrBadArgument]].
>
> argumentCount = 3
> ifTrue: ["normal primitive call with 3 arguments expected on the stack"
> self popStack.
> self primitivePerformAt: lookupClass.
> self successful ifFalse:
> [self push: lookupClass]]
> ifFalse: [argumentCount = 4
> ifTrue: ["mirror primitive call with extra argument specifying object to serve as receiver"
> | s1 s2 s3 s4 s5 |
> "save stack contents"
> s1 := self popStack. "lookupClass"
> s2 := self popStack. "args"
> s3 := self popStack. "selector"
> s4 := self popStack. "mirror receiver"
> s5 := self popStack. "actual receiver"
> "slide stack up one, omitting the actual receiver parameter"
> self push: s4. "mirror receiver"
> self push: s3. "selector"
> self push: s2. "args"
> "perform as if mirror receiver had been the actual receiver"
> self primitivePerformAt: lookupClass.
> self successful ifFalse:
> ["restore original stack"
> self pop: 3. "args, selector, mirror receiver"
> self push: s5. "actual receiver"
> self push: s4. "mirror receiver"
> self push: s3. "selector"
> self push: s2. "args"
> self push: s1. "lookup class" ]]
> ifFalse: ["wrong number of arguments"
> ^self primitiveFailFor: PrimErrBadNumArgs]]
> !
>
> Item was changed:
> ----- Method: Interpreter>>primitivePushFalse (in category 'quick primitives') -----
> primitivePushFalse
> self popStack.
> + self push: objectMemory getFalseObj!
> - self push: objectMemory falseObj!
>
> Item was changed:
> ----- Method: Interpreter>>primitivePushNil (in category 'quick primitives') -----
> primitivePushNil
> self popStack.
> + self push: objectMemory getNilObj!
> - self push: objectMemory nilObj!
>
> Item was changed:
> ----- Method: Interpreter>>primitivePushTrue (in category 'quick primitives') -----
> primitivePushTrue
> self popStack.
> + self push: objectMemory getTrueObj!
> - self push: objectMemory trueObj!
>
> Item was changed:
> ----- Method: Interpreter>>primitiveSetGCSemaphore (in category 'memory space primitives') -----
> primitiveSetGCSemaphore
> "Primitive. Indicate the semaphore to be signalled for upon garbage collection"
> | index |
> <export: true>
> index := self stackIntegerValue: 0.
> self successful ifTrue:[
> + objectMemory setGcSemaphoreIndex: index.
> - objectMemory gcSemaphoreIndex: index.
> self pop: argumentCount.
> ].!
>
> Item was changed:
> ----- Method: Interpreter>>primitiveSignalAtMilliseconds (in category 'system control primitives') -----
> primitiveSignalAtMilliseconds
> "Cause the time semaphore, if one has been registered, to
> be signalled when the millisecond clock is greater than or
> equal to the given tick value. A tick value of zero turns off
> timer interrupts."
> | tick sema |
> tick := self popInteger.
> sema := self popStack.
> self successful
> ifTrue: [(objectMemory fetchClassOf: sema) = (objectMemory splObj: ClassSemaphore)
> ifTrue: [objectMemory
> storePointer: TheTimerSemaphore
> + ofObject: objectMemory getSpecialObjectsOop
> - ofObject: objectMemory specialObjectsOop
> withValue: sema.
> nextWakeupTick := tick]
> ifFalse: [objectMemory
> storePointer: TheTimerSemaphore
> + ofObject: objectMemory getSpecialObjectsOop
> + withValue: objectMemory getNilObj.
> - ofObject: objectMemory specialObjectsOop
> - withValue: objectMemory nilObj.
> nextWakeupTick := 0]]
> ifFalse: [self unPop: 2]!
>
> Item was changed:
> ----- Method: Interpreter>>primitiveStoreStackp (in category 'object access primitives') -----
> primitiveStoreStackp
> "Atomic store into context stackPointer.
> Also ensures that any newly accessible cells are initialized to nil "
> | ctxt newStackp stackp |
> ctxt := self stackValue: 1.
> newStackp := self stackIntegerValue: 0.
> self success: (objectMemory oop: newStackp isGreaterThanOrEqualTo: 0).
> self success: (objectMemory oop: newStackp isLessThanOrEqualTo: (objectMemory largeContextSize - objectMemory baseHeaderSize // objectMemory bytesPerWord - CtxtTempFrameStart)).
> self successful ifFalse: [^ self primitiveFail].
> stackp := self fetchStackPointerOf: ctxt.
> (objectMemory oop: newStackp isGreaterThan: stackp) ifTrue: ["Nil any newly accessible cells"
> + stackp + 1 to: newStackp do: [:i | objectMemory storePointer: i + CtxtTempFrameStart - 1 ofObject: ctxt withValue: objectMemory getNilObj]].
> - stackp + 1 to: newStackp do: [:i | objectMemory storePointer: i + CtxtTempFrameStart - 1 ofObject: ctxt withValue: objectMemory nilObj]].
> self storeStackPointerValue: newStackp inContext: ctxt.
> self pop: 1!
>
> Item was changed:
> ----- Method: Interpreter>>primitiveTerminateTo (in category 'process primitives') -----
> primitiveTerminateTo
> "Primitive. Terminate up the context stack from the receiver up to but not including the argument, if previousContext is on my Context stack. Make previousContext my sender. This prim has to shadow the code in ContextPart>terminateTo: to be correct"
> | thisCntx currentCntx aContext nextCntx nilOop |
> aContext := self popStack.
> thisCntx := self popStack.
>
> "make sure that aContext is in my chain"
> (self context: thisCntx hasSender: aContext) ifTrue:[
> + nilOop := objectMemory getNilObj.
> - nilOop := objectMemory nilObj.
> currentCntx := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
> [currentCntx = aContext] whileFalse: [
> nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCntx.
> objectMemory storePointer: SenderIndex ofObject: currentCntx withValue: nilOop.
> objectMemory storePointer: InstructionPointerIndex ofObject: currentCntx withValue: nilOop.
> currentCntx := nextCntx]].
>
> objectMemory storePointer: SenderIndex ofObject: thisCntx withValue: aContext.
> ^self push: thisCntx!
>
> Item was changed:
> ----- Method: Interpreter>>primitiveVMParameter (in category 'system control primitives') -----
> (excessive size, no diff calculated)
>
> Item was changed:
> ----- Method: Interpreter>>primitiveValue (in category 'control primitives') -----
> primitiveValue
> | blockContext blockArgumentCount initialIP |
> blockContext := self stackValue: argumentCount.
> blockArgumentCount := self argumentCountOfBlock: blockContext.
> self success: (argumentCount = blockArgumentCount
> + and: [(objectMemory fetchPointer: CallerIndex ofObject: blockContext) = objectMemory getNilObj]).
> - and: [(objectMemory fetchPointer: CallerIndex ofObject: blockContext) = objectMemory nilObj]).
> self successful
> ifTrue: [self transfer: argumentCount
> fromIndex: self stackPointerIndex - argumentCount + 1
> ofObject: activeContext
> toIndex: TempFrameStart
> ofObject: blockContext.
>
> "Assume: The call to transfer:... makes blockContext a root if necessary,
> allowing use to use unchecked stored in the following code."
> self pop: argumentCount + 1.
> initialIP := objectMemory fetchPointer: InitialIPIndex ofObject: blockContext.
> objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: blockContext withValue: initialIP.
> self storeStackPointerValue: argumentCount inContext: blockContext.
> objectMemory storePointerUnchecked: CallerIndex ofObject: blockContext withValue: activeContext.
> self newActiveContext: blockContext]!
>
> Item was changed:
> ----- Method: Interpreter>>primitiveValueWithArgs (in category 'control primitives') -----
> primitiveValueWithArgs
> | argumentArray blockContext blockArgumentCount arrayArgumentCount initialIP |
> argumentArray := self popStack.
> blockContext := self popStack.
> blockArgumentCount := self argumentCountOfBlock: blockContext.
> "If the argArray isnt actually an Array we ahve to unpop the above two"
> (objectMemory isArray: argumentArray) ifFalse: [self unPop:2. ^self primitiveFail].
>
> self successful ifTrue: [arrayArgumentCount := objectMemory fetchWordLengthOf: argumentArray.
> self success: (arrayArgumentCount = blockArgumentCount
> + and: [(objectMemory fetchPointer: CallerIndex ofObject: blockContext) = objectMemory getNilObj])].
> - and: [(objectMemory fetchPointer: CallerIndex ofObject: blockContext) = objectMemory nilObj])].
> self successful
> ifTrue: [self
> transfer: arrayArgumentCount
> fromIndex: 0
> ofObject: argumentArray
> toIndex: TempFrameStart
> ofObject: blockContext.
> "Assume: The call to transfer:... makes blockContext a root if necessary,
> allowing use to use unchecked stored in the following code. "
> initialIP := objectMemory fetchPointer: InitialIPIndex ofObject: blockContext.
> objectMemory
> storePointerUnchecked: InstructionPointerIndex
> ofObject: blockContext
> withValue: initialIP.
> self storeStackPointerValue: arrayArgumentCount inContext: blockContext.
> objectMemory
> storePointerUnchecked: CallerIndex
> ofObject: blockContext
> withValue: activeContext.
> self newActiveContext: blockContext]
> ifFalse: [self unPop: 2]!
>
> Item was changed:
> ----- Method: Interpreter>>printAllStacks (in category 'debug printing') -----
> printAllStacks
> "Print all the stacks of all running processes, including those that are currently suspended."
> | oop proc ctx |
> <export: true> "exported to permit access from plugins"
> proc := objectMemory fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer.
> self printNameOfClass: (objectMemory fetchClassOf: proc) count: 5.
> self cr.
> self printCallStackOf: activeContext. "first the active context"
> oop := objectMemory firstObject.
> + [objectMemory oop: oop isLessThan: objectMemory getEndOfMemory] whileTrue:[
> - [objectMemory oop: oop isLessThan: objectMemory endOfMemory] whileTrue:[
> (objectMemory fetchClassOf: oop) == objectMemory classSemaphore ifTrue:[
> self cr.
> proc := objectMemory fetchPointer: FirstLinkIndex ofObject: oop.
> [proc == objectMemory nilObject] whileFalse:[
> self printNameOfClass: (objectMemory fetchClassOf: proc) count: 5.
> self cr.
> ctx := objectMemory fetchPointer: SuspendedContextIndex ofObject: proc.
> ctx == objectMemory nilObject ifFalse:[self printCallStackOf: ctx].
> proc := objectMemory fetchPointer: NextLinkIndex ofObject: proc].
> ].
> oop := objectMemory objectAfter: oop.
> ].!
>
> Item was changed:
> ----- Method: Interpreter>>printCallStackOf: (in category 'debug printing') -----
> printCallStackOf: aContext
>
> | ctxt home methClass methodSel message |
> <inline: false>
> ctxt := aContext.
> + [ctxt = objectMemory getNilObj] whileFalse: [
> - [ctxt = objectMemory nilObj] whileFalse: [
> (objectMemory fetchClassOf: ctxt) = (objectMemory splObj: ClassBlockContext)
> ifTrue: [ home := objectMemory fetchPointer: HomeIndex ofObject: ctxt ]
> ifFalse: [ home := ctxt ].
> methClass :=
> self findClassOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: home)
> forReceiver: (objectMemory fetchPointer: ReceiverIndex ofObject: home).
> methodSel :=
> self findSelectorOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: home)
> forReceiver: (objectMemory fetchPointer: ReceiverIndex ofObject: home).
> self printNum: ctxt.
> self print: ' '.
> ctxt = home ifFalse: [ self print: '[] in ' ].
> self printNameOfClass: methClass count: 5.
> self print: '>'.
> + methodSel = objectMemory getNilObj
> - methodSel = objectMemory nilObj
> ifTrue: [self print: '?']
> ifFalse: [self printStringOf: methodSel].
> methodSel = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue: [
> "print arg message selector"
> message := objectMemory fetchPointer: 0 + TempFrameStart ofObject: home.
> methodSel := objectMemory fetchPointer: MessageSelectorIndex ofObject: message.
> self print: ' '.
> self printStringOf: methodSel.
> ].
> self cr.
>
> ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt).
> ].!
>
> Item was changed:
> ----- Method: Interpreter>>pushBool: (in category 'contexts') -----
> pushBool: trueOrFalse
>
> trueOrFalse
> + ifTrue: [ self push: objectMemory getTrueObj ]
> + ifFalse: [ self push: objectMemory getFalseObj ].!
> - ifTrue: [ self push: objectMemory trueObj ]
> - ifFalse: [ self push: objectMemory falseObj ].!
>
> Item was changed:
> ----- Method: Interpreter>>pushConstantFalseBytecode (in category 'stack bytecodes') -----
> pushConstantFalseBytecode
>
> self fetchNextBytecode.
> + self internalPush: objectMemory getFalseObj.
> - self internalPush: objectMemory falseObj.
> !
>
> Item was changed:
> ----- Method: Interpreter>>pushConstantNilBytecode (in category 'stack bytecodes') -----
> pushConstantNilBytecode
>
> self fetchNextBytecode.
> + self internalPush: objectMemory getNilObj.
> - self internalPush: objectMemory nilObj.
> !
>
> Item was changed:
> ----- Method: Interpreter>>pushConstantTrueBytecode (in category 'stack bytecodes') -----
> pushConstantTrueBytecode
>
> self fetchNextBytecode.
> + self internalPush: objectMemory getTrueObj.
> - self internalPush: objectMemory trueObj.
> !
>
> Item was changed:
> ----- Method: Interpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
> readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
> "Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
> "Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
> "This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
>
> | swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize |
> <var: #f type: 'sqImageFile '>
> <var: #desiredHeapSize type: 'usqInt'>
> <var: #headerStart type: 'squeakFileOffsetType '>
> <var: #dataSize type: 'size_t '>
> <var: #imageOffset type: 'squeakFileOffsetType '>
>
> swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
> headerStart := (self sqImageFilePosition: f) - objectMemory bytesPerWord. "record header start position"
>
> headerSize := self getLongFromFile: f swap: swapBytes.
> dataSize := self getLongFromFile: f swap: swapBytes.
> oldBaseAddr := self getLongFromFile: f swap: swapBytes.
> + objectMemory setSpecialObjectsOop: (self getLongFromFile: f swap: swapBytes).
> + objectMemory setLastHash: (self getLongFromFile: f swap: swapBytes).
> - objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
> - objectMemory lastHash: (self getLongFromFile: f swap: swapBytes).
> savedWindowSize := self getLongFromFile: f swap: swapBytes.
> fullScreenFlag := self oldFormatFullScreenFlag: (self getLongFromFile: f swap: swapBytes).
> extraVMMemory := self getLongFromFile: f swap: swapBytes.
>
> + objectMemory getLastHash = 0 ifTrue: [
> - objectMemory lastHash = 0 ifTrue: [
> "lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
> + objectMemory setLastHash: 999].
> - objectMemory lastHash: 999].
>
> "decrease Squeak object heap to leave extra memory for the VM"
> heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
>
> "compare memory requirements with availability".
> minimumMemory := dataSize + 100000. "need at least 100K of breathing room"
> heapSize < minimumMemory ifTrue: [
> self insufficientMemorySpecifiedError].
>
> "allocate a contiguous block of memory for the Squeak heap"
> (objectMemory allocateMemory: heapSize
> minimum: minimumMemory
> imageFile: f
> headerSize: headerSize) = nil ifTrue: [self insufficientMemoryAvailableError].
>
> memStart := objectMemory startOfMemory.
> + objectMemory setMemoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety"
> + objectMemory setEndOfMemory: memStart + dataSize.
> - objectMemory memoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety"
> - objectMemory endOfMemory: memStart + dataSize.
>
> "position file after the header"
> self sqImageFile: f Seek: headerStart + headerSize.
>
> "read in the image in bulk, then swap the bytes if necessary"
> bytesRead := self
> + sqImage: (objectMemory pointerForOop: objectMemory getMemory)
> - sqImage: (objectMemory pointerForOop: objectMemory memory)
> read: f
> size: (self cCode: 'sizeof(unsigned char)')
> length: dataSize.
> bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
>
> + objectMemory headerTypeBytesAt: 0 put: objectMemory bytesPerWord * 2. "3-word header (type 0)"
> + objectMemory headerTypeBytesAt: 1 put: objectMemory bytesPerWord. "2-word header (type 1)"
> + objectMemory headerTypeBytesAt: 2 put: 0. "free chunk (type 2)"
> + objectMemory headerTypeBytesAt: 3 put: 0. "1-word header (type 3)"
> - objectMemory headerTypeBytes at: 0 put: objectMemory bytesPerWord * 2. "3-word header (type 0)"
> - objectMemory headerTypeBytes at: 1 put: objectMemory bytesPerWord. "2-word header (type 1)"
> - objectMemory headerTypeBytes at: 2 put: 0. "free chunk (type 2)"
> - objectMemory headerTypeBytes at: 3 put: 0. "1-word header (type 3)"
>
> swapBytes ifTrue: [self reverseBytesInImage].
>
> "compute difference between old and new memory base addresses"
> bytesToShift := memStart - oldBaseAddr.
> self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
> self isBigEnder. "work out the machine endianness and cache the answer"
>
> + (self initialImageFormatVersion bitAnd: 1) = 1
> - (self imageFormatInitialVersion bitAnd: 1) = 1
> ifTrue: ["Low order bit set, indicating that the image was saved from
> a StackInterpreter (Cog) VM. Storage of all Float objects must be
> returned to older object memory format."
> self normalizeFloatOrderingInImage].
>
> ^ dataSize
> !
>
> Item was changed:
> ----- Method: Interpreter>>removeFirstLinkOfList: (in category 'process primitive support') -----
> removeFirstLinkOfList: aList
> "Remove the first process from the given linked list."
> | first last next |
> first := objectMemory fetchPointer: FirstLinkIndex ofObject: aList.
> last := objectMemory fetchPointer: LastLinkIndex ofObject: aList.
> first = last
> + ifTrue: [objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: objectMemory getNilObj.
> + objectMemory storePointer: LastLinkIndex ofObject: aList withValue: objectMemory getNilObj]
> - ifTrue: [objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: objectMemory nilObj.
> - objectMemory storePointer: LastLinkIndex ofObject: aList withValue: objectMemory nilObj]
> ifFalse: [next := objectMemory fetchPointer: NextLinkIndex ofObject: first.
> objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: next].
> + objectMemory storePointer: NextLinkIndex ofObject: first withValue: objectMemory getNilObj.
> - objectMemory storePointer: NextLinkIndex ofObject: first withValue: objectMemory nilObj.
> ^ first!
>
> Item was changed:
> ----- Method: Interpreter>>returnFalse (in category 'return bytecodes') -----
> returnFalse
> localReturnContext := self sender.
> + localReturnValue := objectMemory getFalseObj.
> - localReturnValue := objectMemory falseObj.
> self commonReturn.
> !
>
> Item was changed:
> ----- Method: Interpreter>>returnNil (in category 'return bytecodes') -----
> returnNil
> localReturnContext := self sender.
> + localReturnValue := objectMemory getNilObj.
> - localReturnValue := objectMemory nilObj.
> self commonReturn.!
>
> Item was changed:
> ----- Method: Interpreter>>returnTrue (in category 'return bytecodes') -----
> returnTrue
> localReturnContext := self sender.
> + localReturnValue := objectMemory getTrueObj.
> - localReturnValue := objectMemory trueObj.
> self commonReturn.!
>
> Item was changed:
> ----- Method: Interpreter>>reverseBytesInImage (in category 'image save/restore') -----
> reverseBytesInImage
> "Byte-swap all words in memory after reading in the entire image file with bulk read. Contributed by Tim Rowledge."
>
> "First, byte-swap every word in the image. This fixes objects headers."
> + objectMemory reverseBytesFrom: objectMemory startOfMemory to: objectMemory getEndOfMemory.
> - objectMemory reverseBytesFrom: objectMemory startOfMemory to: objectMemory endOfMemory.
>
> "Second, return the bytes of bytes-type objects to their orginal order."
> self byteSwapByteObjects.!
>
> Item was changed:
> ----- Method: Interpreter>>saveProcessSignalingLowSpace (in category 'process primitive support') -----
> saveProcessSignalingLowSpace
> "The low space semaphore is about to be signaled. Save the currently active
> process in the special objects array so that the low space handler will be able
> to determine the process that first triggered a low space condition. The low
> space handler (in the image) is expected to nil out the special objects array
> slot when it handles the low space condition."
>
> | lastSavedProcess sched currentProc |
> lastSavedProcess := objectMemory splObj: ProcessSignalingLowSpace.
> (lastSavedProcess == objectMemory nilObject) ifTrue:
> [sched := self schedulerPointer.
> currentProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
> + objectMemory storePointer: ProcessSignalingLowSpace ofObject: objectMemory getSpecialObjectsOop withValue: currentProc]!
> - objectMemory storePointer: ProcessSignalingLowSpace ofObject: objectMemory specialObjectsOop withValue: currentProc]!
>
> Item was changed:
> ----- Method: Interpreter>>sender (in category 'contexts') -----
> sender
>
> | context closureOrNil |
> context := localHomeContext.
> + [(closureOrNil := objectMemory fetchPointer: ClosureIndex ofObject: context) ~~ objectMemory getNilObj] whileTrue:
> - [(closureOrNil := objectMemory fetchPointer: ClosureIndex ofObject: context) ~~ objectMemory nilObj] whileTrue:
> [context := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closureOrNil].
> ^objectMemory fetchPointer: SenderIndex ofObject: context!
>
> Item was changed:
> ----- Method: Interpreter>>snapshot: (in category 'image save/restore') -----
> snapshot: embedded
> "update state of active context"
> | activeProc dataSize rcvr setMacType |
> <var: #setMacType type: 'void *'>
> compilerInitialized
> ifTrue: [self compilerPreSnapshot]
> ifFalse: [self storeContextRegisters: activeContext].
>
> "update state of active process"
> activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer.
> objectMemory
> storePointer: SuspendedContextIndex
> ofObject: activeProc
> withValue: activeContext.
>
> "compact memory and compute the size of the memory actually in use"
> objectMemory incrementalGC.
>
> "maximimize space for forwarding table"
> objectMemory fullGC.
> self snapshotCleanUp.
>
> + dataSize := objectMemory getFreeBlock - objectMemory startOfMemory. "Assume all objects are below the start of the free block"
> - dataSize := objectMemory freeBlock - objectMemory startOfMemory. "Assume all objects are below the start of the free block"
> self successful
> ifTrue: [rcvr := self popStack.
> "pop rcvr"
> + self push: objectMemory getTrueObj.
> - self push: objectMemory trueObj.
> self writeImageFile: dataSize.
> embedded
> ifFalse: ["set Mac file type and creator; this is a noop on other platforms"
> setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'.
> setMacType = 0
> ifFalse: [self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']].
> self pop: 1].
>
> "activeContext was unmarked in #snapshotCleanUp, mark it old "
> objectMemory beRootIfOld: activeContext.
> self successful
> + ifTrue: [self push: objectMemory getFalseObj]
> - ifTrue: [self push: objectMemory falseObj]
> ifFalse: [self push: rcvr].
> compilerInitialized
> ifTrue: [self compilerPostSnapshot]!
>
> Item was changed:
> ----- Method: Interpreter>>snapshotCleanUp (in category 'image save/restore') -----
> snapshotCleanUp
> "Clean up right before saving an image, sweeping memory and:
> * nilling out all fields of contexts above the stack pointer.
> * flushing external primitives
> * clearing the root bit of any object in the root table "
> | oop header fmt sz |
> oop := objectMemory firstObject.
> + [objectMemory oop: oop isLessThan: objectMemory getEndOfMemory]
> - [objectMemory oop: oop isLessThan: objectMemory endOfMemory]
> whileTrue: [(objectMemory isFreeObject: oop)
> ifFalse: [header := objectMemory longAt: oop.
> fmt := header >> 8 bitAnd: 15.
> "Clean out context"
> (fmt = 3 and: [self isContextHeader: header])
> ifTrue: [sz := objectMemory sizeBitsOf: oop.
> (objectMemory lastPointerOf: oop) + objectMemory bytesPerWord
> to: sz - objectMemory baseHeaderSize by: objectMemory bytesPerWord
> + do: [:i | objectMemory longAt: oop + i put: objectMemory getNilObj]].
> - do: [:i | objectMemory longAt: oop + i put: objectMemory nilObj]].
> "Clean out external functions"
> fmt >= 12
> ifTrue: ["This is a compiled method"
> (self primitiveIndexOf: oop) = PrimitiveExternalCallIndex
> ifTrue: ["It's primitiveExternalCall"
> self flushExternalPrimitiveOf: oop]]].
> oop := objectMemory objectAfter: oop].
> objectMemory clearRootsTable!
>
> Item was changed:
> ----- Method: Interpreter>>storeAndPopReceiverVariableBytecode (in category 'stack bytecodes') -----
> storeAndPopReceiverVariableBytecode
> "Note: This code uses
> storePointerUnchecked:ofObject:withValue: and does the
> store check explicitely in order to help the translator
> produce better code."
> | rcvr top |
> self flag: #'requires currentBytecode to be expanded to a constant'.
> self fetchNextBytecode.
> "this bytecode will be expanded so that refs to currentBytecode below will be constant"
> rcvr := receiver.
> top := self internalStackTop.
> + (objectMemory oop: rcvr isLessThan: objectMemory getYoungStart)
> - (objectMemory oop: rcvr isLessThan: objectMemory youngStart)
> ifTrue: [objectMemory possibleRootStoreInto: rcvr value: top].
> objectMemory storePointerUnchecked: (currentBytecode bitAnd: 7) ofObject: rcvr withValue: top.
> self internalPop: 1!
>
> Item was changed:
> ----- Method: Interpreter>>transferTo: (in category 'process primitive support') -----
> transferTo: aProc
> "Record a process to be awoken on the next interpreter cycle.
> ikp 11/24/1999 06:07 -- added hook for external runtime
> compiler "
> | sched oldProc newProc |
> newProc := aProc.
> sched := self schedulerPointer.
> oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
> objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc.
> compilerInitialized
> ifTrue: [self compilerProcessChange: oldProc to: newProc]
> ifFalse: [objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext.
> self newActiveContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: newProc).
> + objectMemory storePointer: SuspendedContextIndex ofObject: newProc withValue: objectMemory getNilObj].
> - objectMemory storePointer: SuspendedContextIndex ofObject: newProc withValue: objectMemory nilObj].
> reclaimableContextCount := 0!
>
> Item was changed:
> ----- Method: Interpreter>>writeImageFileIO: (in category 'image save/restore') -----
> writeImageFileIO: imageBytes
>
> | headerStart headerSize f bytesWritten sCWIfn okToWrite |
> <var: #f type: 'sqImageFile'>
> <var: #headerStart type: 'squeakFileOffsetType '>
> <var: #sCWIfn type: 'void *'>
>
> "If the security plugin can be loaded, use it to check for write permission.
> If not, assume it's ok"
> sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
> sCWIfn ~= 0 ifTrue:[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
> okToWrite ifFalse:[^self primitiveFail]].
>
> "local constants"
> headerStart := 0.
> headerSize := 16 * objectMemory bytesPerWord. "header size in bytes; do not change!!"
>
> f := self cCode: 'sqImageFileOpen(imageName, "wb")'.
> f = nil ifTrue: [
> "could not open the image file for writing"
> self success: false.
> ^ nil].
>
> headerStart := self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+imageBytes)'.
> self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
> "position file to start of header"
> self sqImageFile: f Seek: headerStart.
>
> self putLong: (self imageFormatVersion) toFile: f.
> self putLong: headerSize toFile: f.
> self putLong: imageBytes toFile: f.
> self putLong: (objectMemory startOfMemory) toFile: f.
> + self putLong: objectMemory getSpecialObjectsOop toFile: f.
> + self putLong: objectMemory getLastHash toFile: f.
> - self putLong: objectMemory specialObjectsOop toFile: f.
> - self putLong: objectMemory lastHash toFile: f.
> self putLong: (self ioScreenSize) toFile: f.
> self putLong: fullScreenFlag toFile: f.
> self putLong: extraVMMemory toFile: f.
> 1 to: 7 do: [:i | self putLong: 0 toFile: f]. "fill remaining header words with zeros"
> self successful ifFalse: [
> "file write or seek failure"
> self cCode: 'sqImageFileClose(f)'.
> ^ nil].
>
> "position file after the header"
> self sqImageFile: f Seek: headerStart + headerSize.
>
> "write the image data"
> bytesWritten := self
> + sqImage: (objectMemory pointerForOop: objectMemory getMemory)
> - sqImage: (objectMemory pointerForOop: objectMemory memory)
> write: f
> size: (self cCode: 'sizeof(unsigned char)')
> length: imageBytes.
> self success: bytesWritten = imageBytes.
> self cCode: 'sqImageFileClose(f)'.
>
> !
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveBeDisplay (in category 'I/O primitives') -----
> primitiveBeDisplay
> "Record the system Display object in the specialObjectsTable."
> | rcvr |
> rcvr := self stackTop.
> self success: ((objectMemory isPointers: rcvr) and: [(objectMemory lengthOf: rcvr) >= 4]).
> + self successful ifTrue: [objectMemory storePointer: TheDisplay ofObject: objectMemory getSpecialObjectsOop withValue: rcvr]!
> - self successful ifTrue: [objectMemory storePointer: TheDisplay ofObject: objectMemory specialObjectsOop withValue: rcvr]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveBytesLeft (in category 'memory space primitives') -----
> primitiveBytesLeft
> "Reports bytes available at this moment. For more meaningful
> results, calls to this primitive should be preceeded by a full
> or incremental garbage collection."
> | aBool |
> self methodArgumentCount = 0
> ifTrue: ["old behavior - just return the size of the free block"
> + ^self pop: 1 thenPush: (self positive64BitIntegerFor: (objectMemory sizeOfFree: objectMemory getFreeBlock))].
> - ^self pop: 1 thenPush: (self positive64BitIntegerFor: (objectMemory sizeOfFree: objectMemory freeBlock))].
> self methodArgumentCount = 1
> ifTrue: ["new behaviour -including or excluding swap space depending on aBool"
> aBool := self booleanValueOf: self stackTop.
> self successful ifFalse: [^ nil].
> ^self pop: 2 thenPush: (self positive64BitIntegerFor: (objectMemory bytesLeft: aBool))].
> ^ self primitiveFail!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveFailAfterCleanup: (in category 'image segment in/out') -----
> primitiveFailAfterCleanup: outPointerArray
> "If the storeSegment primitive fails, it must clean up first."
>
> | i lastAddr | "Store nils throughout the outPointer array."
> lastAddr := outPointerArray + (objectMemory lastPointerOf: outPointerArray).
> i := outPointerArray + objectMemory baseHeaderSize.
> [i <= lastAddr] whileTrue:
> + [objectMemory longAt: i put: objectMemory getNilObj.
> - [objectMemory longAt: i put: objectMemory nilObj.
> i := i + objectMemory bytesPerWord].
>
> DoAssertionChecks ifTrue: [objectMemory verifyCleanHeaders].
> self primitiveFail!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveFindHandlerContext (in category 'control primitives') -----
> primitiveFindHandlerContext
> "Primitive. Search up the context stack for the next method context marked for exception handling starting at the receiver. Return nil if none found"
> | thisCntx nilOop |
> thisCntx := self popStack.
> + nilOop := objectMemory getNilObj.
> - nilOop := objectMemory nilObj.
>
> [(self isHandlerMarked: thisCntx) ifTrue:[
> self push: thisCntx.
> ^nil].
> thisCntx := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
> thisCntx = nilOop] whileFalse.
>
> + ^self push: objectMemory getNilObj!
> - ^self push: objectMemory nilObj!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveFindNextUnwindContext (in category 'control primitives') -----
> primitiveFindNextUnwindContext
> "Primitive. Search up the context stack for the next method context marked for unwind handling from the receiver up to but not including the argument. Return nil if none found."
> | thisCntx nilOop aContext unwindMarked |
> aContext := self popStack.
> thisCntx := objectMemory fetchPointer: SenderIndex ofObject: self popStack.
> + nilOop := objectMemory getNilObj.
> - nilOop := objectMemory nilObj.
>
> [(thisCntx = aContext) or: [thisCntx = nilOop]] whileFalse: [
> unwindMarked := self isUnwindMarked: thisCntx.
> unwindMarked ifTrue:[
> self push: thisCntx.
> ^nil].
> thisCntx := objectMemory fetchPointer: SenderIndex ofObject: thisCntx].
>
> ^self push: nilOop!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveForceTenure (in category 'I/O primitives') -----
> primitiveForceTenure
> "Set force tenure flag to true, this forces a tenure operation on the next incremental GC"
>
> <export: true>
> + objectMemory setForceTenureFlag: 1!
> - objectMemory forceTenureFlag: 1!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveInterruptSemaphore (in category 'I/O primitives') -----
> primitiveInterruptSemaphore
> "Register the user interrupt semaphore. If the argument is
> not a Semaphore, unregister the current interrupt
> semaphore. "
> | arg |
> arg := self popStack.
> (objectMemory fetchClassOf: arg) = (objectMemory splObj: ClassSemaphore)
> + ifTrue: [objectMemory storePointer: TheInterruptSemaphore ofObject: objectMemory getSpecialObjectsOop withValue: arg]
> + ifFalse: [objectMemory storePointer: TheInterruptSemaphore ofObject: objectMemory getSpecialObjectsOop withValue: objectMemory getNilObj]!
> - ifTrue: [objectMemory storePointer: TheInterruptSemaphore ofObject: objectMemory specialObjectsOop withValue: arg]
> - ifFalse: [objectMemory storePointer: TheInterruptSemaphore ofObject: objectMemory specialObjectsOop withValue: objectMemory nilObj]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveIsYoung (in category 'memory space primitives') -----
> primitiveIsYoung
> "Primitive. Answer whether the argument to the primitive resides in young space."
> | oop |
> <export: true>
> oop := self stackObjectValue: 0.
> self successful ifTrue:[
> self pop: argumentCount + 1.
> + self pushBool: (objectMemory oop: oop isGreaterThanOrEqualTo: objectMemory getYoungStart).
> - self pushBool: (objectMemory oop: oop isGreaterThanOrEqualTo: objectMemory youngStart).
> ].!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveKbdNext (in category 'I/O primitives') -----
> primitiveKbdNext
> "Obsolete on virtually all platforms; old style input polling code.
> Return the next keycode and remove it from the input buffer. The low byte is the 8-bit ISO character. The next four bits are the Smalltalk modifier bits <cmd><option><ctrl><shift>."
>
> | keystrokeWord |
> self pop: 1.
> keystrokeWord := self ioGetKeystroke.
> keystrokeWord >= 0
> ifTrue: [self pushInteger: keystrokeWord]
> + ifFalse: [self push: objectMemory getNilObj].!
> - ifFalse: [self push: objectMemory nilObj].!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveKbdPeek (in category 'I/O primitives') -----
> primitiveKbdPeek
> "Obsolete on virtually all platforms; old style input polling code.
> Return the next keycode and without removing it from the input buffer. The low byte is the 8-bit ISO character. The next four bits are the Smalltalk modifier bits <cmd><option><ctrl><shift>."
>
> | keystrokeWord |
> self pop: 1.
> keystrokeWord := self ioPeekKeystroke.
> keystrokeWord >= 0
> ifTrue: [self pushInteger: keystrokeWord]
> + ifFalse: [self push: objectMemory getNilObj].!
> - ifFalse: [self push: objectMemory nilObj].!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveLoadImageSegment (in category 'image segment in/out') -----
> primitiveLoadImageSegment
> "This primitive is called from Squeak as...
> <imageSegment> loadSegmentFrom: aWordArray outPointers: anArray."
>
> "This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of zero. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you have done with it anyway?"
>
> | outPointerArray segmentWordArray endSeg segOop fieldPtr fieldOop doingClass lastPtr extraSize mapOop lastOut outPtr hdrTypeBits header data |
>
> <var: #endSeg type: 'usqInt'>
> <var: #segOop type: 'usqInt'>
> <var: #fieldPtr type: 'usqInt'>
> <var: #lastOut type: 'usqInt'>
> <var: #outPtr type: 'usqInt'>
> <var: #lastPtr type: 'usqInt'>
>
> DoAssertionChecks ifTrue: [objectMemory verifyCleanHeaders].
> outPointerArray := self stackTop.
> lastOut := outPointerArray + (objectMemory lastPointerOf: outPointerArray).
> segmentWordArray := self stackValue: 1.
> endSeg := segmentWordArray + (objectMemory sizeBitsOf: segmentWordArray) - objectMemory baseHeaderSize.
>
> "Essential type checks"
> ((objectMemory formatOf: outPointerArray) = 2 "Must be indexable pointers"
> and: [(objectMemory formatOf: segmentWordArray) = 6]) "Must be indexable words"
> ifFalse: [^ self primitiveFail].
>
> "Version check. Byte order of the WordArray now"
> data := objectMemory longAt: segmentWordArray + objectMemory baseHeaderSize.
> (self readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: [
> "Not readable -- try again with reversed bytes..."
> objectMemory reverseBytesFrom: segmentWordArray + objectMemory baseHeaderSize to: endSeg + objectMemory bytesPerWord.
> data := objectMemory longAt: segmentWordArray + objectMemory baseHeaderSize.
> (self readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: [
> "Still NG -- put things back and fail"
> objectMemory reverseBytesFrom: segmentWordArray + objectMemory baseHeaderSize to: endSeg + objectMemory bytesPerWord.
> DoAssertionChecks ifTrue: [objectMemory verifyCleanHeaders].
> ^ self primitiveFail]].
> "Reverse the Byte type objects if the is data from opposite endian machine."
> "Test top byte. $d on the Mac or $s on the PC. Rest of word is equal."
> (data >> 16) = (objectMemory imageSegmentVersion >> 16) ifFalse: [
> "Reverse the byte-type objects once"
> segOop := objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord.
> "Oop of first embedded object"
> self byteSwapByteObjectsFrom: segOop to: endSeg + objectMemory bytesPerWord].
>
> "Proceed through the segment, remapping pointers..."
> segOop := objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord.
> [segOop <= endSeg] whileTrue:
> [(objectMemory headerType: segOop) <= 1
> ifTrue: ["This object has a class field (type = 0 or 1) -- start with that."
> fieldPtr := segOop - objectMemory bytesPerWord. doingClass := true]
> ifFalse: ["No class field -- start with first data field"
> fieldPtr := segOop + objectMemory baseHeaderSize. doingClass := false].
> lastPtr := segOop + (objectMemory lastPointerOf: segOop). "last field"
> lastPtr > endSeg ifTrue: [
> DoAssertionChecks ifTrue: [objectMemory verifyCleanHeaders].
> ^ self primitiveFail "out of bounds"].
>
> "Go through all oops, remapping them..."
> [fieldPtr > lastPtr] whileFalse:
> ["Examine each pointer field"
> fieldOop := objectMemory longAt: fieldPtr.
> doingClass ifTrue:
> [hdrTypeBits := objectMemory headerType: fieldPtr.
> fieldOop := fieldOop - hdrTypeBits].
> (objectMemory isIntegerObject: fieldOop)
> ifTrue:
> ["Integer -- nothing to do"
> fieldPtr := fieldPtr + objectMemory bytesPerWord]
> ifFalse:
> [(fieldOop bitAnd: 3) = 0 ifFalse: [^ self primitiveFail "bad oop"].
> (fieldOop bitAnd: 16r80000000) = 0
> ifTrue: ["Internal pointer -- add segment offset"
> mapOop := fieldOop + segmentWordArray]
> ifFalse: ["External pointer -- look it up in outPointers"
> outPtr := outPointerArray + (fieldOop bitAnd: 16r7FFFFFFF).
> outPtr > lastOut ifTrue: [^ self primitiveFail "out of bounds"].
> mapOop := objectMemory longAt: outPtr].
> doingClass
> ifTrue: [objectMemory longAt: fieldPtr put: mapOop + hdrTypeBits.
> fieldPtr := fieldPtr + 8.
> doingClass := false]
> ifFalse: [objectMemory longAt: fieldPtr put: mapOop.
> fieldPtr := fieldPtr + objectMemory bytesPerWord].
> + segOop < objectMemory getYoungStart
> - segOop < objectMemory youngStart
> ifTrue: [objectMemory possibleRootStoreInto: segOop value: mapOop].
> ]].
> segOop := objectMemory objectAfter: segOop].
>
> "Again, proceed through the segment checking consistency..."
> segOop := objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord.
> [segOop <= endSeg] whileTrue:
> [(objectMemory oopHasAcceptableClass: segOop) ifFalse: [^ self primitiveFail "inconsistency"].
> fieldPtr := segOop + objectMemory baseHeaderSize. "first field"
> lastPtr := segOop + (objectMemory lastPointerOf: segOop). "last field"
> "Go through all oops, remapping them..."
> [fieldPtr > lastPtr] whileFalse:
> ["Examine each pointer field"
> fieldOop := objectMemory longAt: fieldPtr.
> (objectMemory oopHasAcceptableClass: fieldOop) ifFalse: [^ self primitiveFail "inconsistency"].
> fieldPtr := fieldPtr + objectMemory bytesPerWord].
> segOop := objectMemory objectAfter: segOop].
>
> "Truncate the segment word array to size = objectMemory bytesPerWord (vers stamp only)"
> extraSize := objectMemory extraHeaderBytes: segmentWordArray.
> hdrTypeBits := objectMemory headerType: segmentWordArray.
> extraSize = 8
> ifTrue: [objectMemory longAt: segmentWordArray-extraSize put: objectMemory baseHeaderSize + objectMemory bytesPerWord + hdrTypeBits]
> ifFalse: [header := objectMemory longAt: segmentWordArray.
> objectMemory longAt: segmentWordArray
> put: header - (header bitAnd: objectMemory sizeMask) + objectMemory baseHeaderSize + objectMemory bytesPerWord].
> "and return the roots array which was first in the segment"
> DoAssertionChecks ifTrue: [objectMemory verifyCleanHeaders].
> self pop: 3 thenPush: (objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord).
> !
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveLowSpaceSemaphore (in category 'memory space primitives') -----
> primitiveLowSpaceSemaphore
> "Register the low-space semaphore. If the argument is not a
> Semaphore, unregister the current low-space Semaphore."
> | arg |
> arg := self popStack.
> (objectMemory fetchClassOf: arg) = (objectMemory splObj: ClassSemaphore)
> + ifTrue: [objectMemory storePointer: TheLowSpaceSemaphore ofObject: objectMemory getSpecialObjectsOop withValue: arg]
> + ifFalse: [objectMemory storePointer: TheLowSpaceSemaphore ofObject: objectMemory getSpecialObjectsOop withValue: objectMemory getNilObj]!
> - ifTrue: [objectMemory storePointer: TheLowSpaceSemaphore ofObject: objectMemory specialObjectsOop withValue: arg]
> - ifFalse: [objectMemory storePointer: TheLowSpaceSemaphore ofObject: objectMemory specialObjectsOop withValue: objectMemory nilObj]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveNewMethod (in category 'compiled methods') -----
> primitiveNewMethod
> | header bytecodeCount class size theMethod literalCount |
> header := self popStack.
> bytecodeCount := self popInteger.
> self success: (objectMemory isIntegerObject: header).
> self successful ifFalse:
> [self unPop: 2. ^nil].
> class := self popStack.
> size := (self literalCountOfHeader: header) + 1 * objectMemory bytesPerWord + bytecodeCount.
> theMethod := objectMemory instantiateClass: class indexableSize: size.
> objectMemory storePointerUnchecked: HeaderIndex ofObject: theMethod withValue: header.
> literalCount := self literalCountOfHeader: header.
> 1 to: literalCount do:
> + [:i | objectMemory storePointer: i ofObject: theMethod withValue: objectMemory getNilObj].
> - [:i | objectMemory storePointer: i ofObject: theMethod withValue: objectMemory nilObj].
> self push: theMethod!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveNextInstance (in category 'object access primitives') -----
> primitiveNextInstance
> | object instance |
> object := self stackTop.
> instance := objectMemory instanceAfter: object.
> + instance = objectMemory getNilObj
> - instance = objectMemory nilObj
> ifTrue: [self primitiveFail]
> ifFalse: [self pop: argumentCount+1 thenPush: instance]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveRootTable (in category 'memory space primitives') -----
> primitiveRootTable
> "Primitive. Answer a copy (snapshot) element of the root table.
> The primitive can cause GC itself and if so the return value may
> be inaccurate - in this case one should guard the read operation
> by looking at the gc counter statistics."
> | oop sz |
> <export: true>
> + sz := objectMemory getRootTableCount.
> - sz := objectMemory rootTableCount.
> oop := objectMemory instantiateClass: objectMemory classArray indexableSize: sz. "can cause GC"
> + sz > objectMemory getRootTableCount ifTrue:[sz := objectMemory getRootTableCount].
> - sz > objectMemory rootTableCount ifTrue:[sz := objectMemory rootTableCount].
> 1 to: sz do:[:i|
> + objectMemory storePointer: i-1 ofObject: oop withValue: (objectMemory rootTableAt: i).
> - objectMemory storePointer: i-1 ofObject: oop withValue: (objectMemory rootTable at: i).
> ].
> self pop: argumentCount + 1.
> self push: oop.!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveRootTableAt (in category 'memory space primitives') -----
> primitiveRootTableAt
> "Primitive. Answer the nth element of the root table.
> This primitive avoids the creation of an extra array;
> it is intended for enumerations of the form:
> index := 1.
> [root := Smalltalk rootTableAt: index.
> root == nil] whileFalse:[index := index + 1].
> "
> | index |
> <export: true>
> index := self stackIntegerValue: 0.
> + self success: (index > 0 and:[index <= objectMemory getRootTableCount]).
> - self success: (index > 0 and:[index <= objectMemory rootTableCount]).
> self successful ifTrue:[
> self pop: argumentCount + 1.
> + self push: (objectMemory rootTableAt: index).
> - self push: (objectMemory rootTable at: index).
> ].!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveSetFullScreen (in category 'I/O primitives') -----
> primitiveSetFullScreen
> "On platforms that support it, set full-screen mode to the value of the boolean argument."
>
> | argOop |
> argOop := self stackTop.
> + argOop = objectMemory getTrueObj
> - argOop = objectMemory trueObj
> ifTrue: [self ioSetFullScreen: true]
> + ifFalse: [ argOop = objectMemory getFalseObj
> - ifFalse: [ argOop = objectMemory falseObj
> ifTrue: [self ioSetFullScreen: false]
> ifFalse: [self primitiveFail]].
> self successful ifTrue: [self pop: 1].
> !
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveSetGCBiasToGrow (in category 'memory space primitives') -----
> primitiveSetGCBiasToGrow
> "Primitive. Indicate if the GC logic should have bias to grow"
> | flag |
> <export: true>
> flag := self stackIntegerValue: 0.
> self successful ifTrue:[
> + objectMemory setGcBiasToGrow: flag.
> - objectMemory gcBiasToGrow: flag.
> self pop: argumentCount.
> ].!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveSignalAtBytesLeft (in category 'memory space primitives') -----
> primitiveSignalAtBytesLeft
> "Set the low-water mark for free space. When the free space
> falls below this level, the new and new: primitives fail and
> system attempts to allocate space (e.g., to create a method
> context) cause the low-space semaphore (if one is
> registered) to be signalled."
> | bytes |
> bytes := self popInteger.
> self successful
> + ifTrue: [objectMemory setLowSpaceThreshold: bytes]
> + ifFalse: [objectMemory setLowSpaceThreshold: 0.
> - ifTrue: [objectMemory lowSpaceThreshold: bytes]
> - ifFalse: [objectMemory lowSpaceThreshold: 0.
> self unPop: 1]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveSomeInstance (in category 'object access primitives') -----
> primitiveSomeInstance
> | class instance |
> class := self stackTop.
> instance := objectMemory initialInstanceOf: class.
> + instance = objectMemory getNilObj
> - instance = objectMemory nilObj
> ifTrue: [self primitiveFail]
> ifFalse: [self pop: argumentCount+1 thenPush: instance]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveSpecialObjectsOop (in category 'system control primitives') -----
> primitiveSpecialObjectsOop
> "Return the oop of the SpecialObjectsArray."
>
> + self pop: 1 thenPush: objectMemory getSpecialObjectsOop.!
> - self pop: 1 thenPush: objectMemory specialObjectsOop.!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveStoreImageSegment (in category 'image segment in/out') -----
> (excessive size, no diff calculated)
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveSuspend (in category 'process primitives') -----
> primitiveSuspend
> "Primitive. Suspend the receiver, aProcess such that it can be executed again
> by sending #resume. If the given process is not currently running, take it off
> its corresponding list. The primitive returns the list the receiver was previously on."
>
> | process activeProc myList |
> process := self stackTop.
> activeProc := objectMemory fetchPointer: ActiveProcessIndex
> ofObject: self schedulerPointer.
> process == activeProc ifTrue:[
> self pop: 1.
> + self push: objectMemory getNilObj.
> - self push: objectMemory nilObj.
> self transferTo: self wakeHighestPriority.
> ] ifFalse:[
> myList := objectMemory fetchPointer: MyListIndex ofObject: process.
> "XXXX Fixme. We should really check whether myList is a kind of LinkedList or not
> but we can't easily so just do a quick check for nil which is the most common case."
> + myList == objectMemory getNilObj ifTrue:[^self primitiveFail].
> - myList == objectMemory nilObject ifTrue:[^self primitiveFail].
> self removeProcess: process fromList: myList.
> self successful ifTrue:[
> + objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory getNilObj.
> - objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject.
> self pop: 1.
> self push: myList.
> ].
> ].
> !
>
> Item was changed:
> ----- Method: InterpreterSimulator class>>on: (in category 'instance creation') -----
> on: objectMemory
> | interp |
> interp := self == InterpreterSimulator
> ifTrue: [SmalltalkImage current endianness == #big
> ifTrue: [InterpreterSimulatorMSB basicNew]
> ifFalse: [InterpreterSimulatorLSB basicNew]]
> ifFalse: [super basicNew].
> interp objectMemory: objectMemory.
> + objectMemory setInterpreter: interp.
> - objectMemory interpreter: interp.
> ^ interp initialize
> !
>
> Item was changed:
> ----- Method: InterpreterSimulator>>classAndSelectorOfMethod:forReceiver: (in category 'debug support') -----
> classAndSelectorOfMethod: meth forReceiver: rcvr
> | mClass dict length methodArray |
> mClass := objectMemory fetchClassOf: rcvr.
> [dict := objectMemory fetchPointer: MessageDictionaryIndex ofObject: mClass.
> length := objectMemory fetchWordLengthOf: dict.
> methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dict.
> 0 to: length-SelectorStart-1 do:
> [:index |
> meth = (objectMemory fetchPointer: index ofObject: methodArray)
> ifTrue: [^ Array
> with: mClass
> with: (objectMemory fetchPointer: index + SelectorStart ofObject: dict)]].
> mClass := objectMemory fetchPointer: SuperclassIndex ofObject: mClass.
> + mClass = objectMemory getNilObj]
> - mClass = objectMemory nilObj]
> whileFalse: [].
> ^ Array
> with: (objectMemory fetchClassOf: rcvr)
> with: (objectMemory splObj: SelectorDoesNotUnderstand)!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>compactClassAt: (in category 'debug support') -----
> compactClassAt: ccIndex
> "Index must be between 1 and compactClassArray size. (A zero compact class index in the base header indicate that the class is in the class header word.)"
>
> | classArray |
> + classArray := objectMemory fetchPointer: CompactClasses ofObject: objectMemory getSpecialObjectsOop.
> - classArray := objectMemory fetchPointer: CompactClasses ofObject: objectMemory specialObjectsOop.
> ^ objectMemory fetchPointer: (ccIndex - 1) ofObject: classArray!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>convertToArray (in category 'initialization') -----
> convertToArray
> "I dont believe it -- this *just works*"
> "The comment above is from the original method, stamped di 5/8/2004 16:42"
>
> + objectMemory setMemory: (objectMemory getMemory as: Array)!
> - objectMemory memory: (objectMemory memory as: Array)!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>initialize (in category 'initialization') -----
> initialize
>
> "Initialize the InterpreterSimulator when running the interpreter inside
> Smalltalk. The primary responsibility of this method is to allocate
> Smalltalk Arrays for variables that will be declared as statically-allocated
> global arrays in the translated code."
>
> "copy of bytesPerWord to avoid extra indirection that may affect performance"
> bytesPerWord := objectMemory bytesPerWord.
>
> "initialize class variables"
> ObjectMemory initializeConstants.
> Interpreter initialize.
>
> "Note: we must initialize ConstMinusOne differently for simulation,
> due to the fact that the simulator works only with +ve 32-bit values"
> ConstMinusOne := objectMemory integerObjectOf: -1.
>
> methodCache := Array new: MethodCacheSize.
> atCache := Array new: AtCacheTotalSize.
> self flushMethodCache.
> + objectMemory setRootTable: (Array new: ObjectMemory rootTableSize).
> + objectMemory setWeakRoots: (Array new: ObjectMemory rootTableSize + ObjectMemory remapBufferSize + 100).
> + objectMemory setRemapBuffer: (Array new: ObjectMemory remapBufferSize).
> - objectMemory rootTable: (Array new: ObjectMemory rootTableSize).
> - objectMemory weakRoots: (Array new: ObjectMemory rootTableSize + ObjectMemory remapBufferSize + 100).
> - objectMemory remapBuffer: (Array new: ObjectMemory remapBufferSize).
> semaphoresUseBufferA := true.
> semaphoresToSignalA := Array new: SemaphoresToSignalSize.
> semaphoresToSignalB := Array new: SemaphoresToSignalSize.
> externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
> primitiveTable := self class primitiveTable.
> pluginList := #().
> mappedPluginEntries := #().
>
> "initialize InterpreterSimulator variables used for debugging"
> byteCount := 0.
> sendCount := 0.
> quitBlock := [^ self].
> traceOn := true.
> myBitBlt := BitBltSimulator new setInterpreter: self.
> filesOpen := OrderedCollection new.
> + objectMemory setHeaderTypeBytes: (CArrayAccessor on: (Array with: bytesPerWord * 2 with: bytesPerWord with: 0 with: 0)).
> - objectMemory headerTypeBytes: (CArrayAccessor on: (Array with: bytesPerWord * 2 with: bytesPerWord with: 0 with: 0)).
> transcript := Transcript.
> objectMemory transcript: Transcript.
> displayForm := 'Display has not yet been installed' asDisplayText form.
> !
>
> Item was changed:
> ----- Method: InterpreterSimulator>>lookupMethodInClass: (in category 'debug support') -----
> lookupMethodInClass: class
> | currentClass dictionary found rclass |
>
> "This method overrides the interp, causing a halt on MNU."
> "true ifTrue: [^ super lookupMethodInClass: class]." "Defeat debug support"
>
> currentClass := class.
> + [currentClass ~= objectMemory getNilObj]
> - [currentClass ~= objectMemory nilObj]
> whileTrue:
> [dictionary := objectMemory fetchPointer: MessageDictionaryIndex ofObject: currentClass.
> + dictionary = objectMemory getNilObj ifTrue:
> - dictionary = objectMemory nilObj ifTrue:
> ["MethodDict pointer is nil (hopefully due a swapped out stub)
> -- raise exception #cannotInterpret:."
> objectMemory pushRemappableOop: currentClass. "may cause GC!!"
> self createActualMessageTo: class.
> currentClass := objectMemory popRemappableOop.
> messageSelector := objectMemory splObj: SelectorCannotInterpret.
> ^ self lookupMethodInClass: (self superclassOf: currentClass)].
>
> found := self lookupMethodInDictionary: dictionary.
> found ifTrue: [^ methodClass := currentClass].
> currentClass := self superclassOf: currentClass].
>
> "Could not find #doesNotUnderstand: -- unrecoverable error."
> messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue:
> [self error: 'Recursive not understood error encountered'].
>
> self halt: (self stringOf: messageSelector).
>
> "Cound not find a normal message -- raise exception #doesNotUnderstand:"
> objectMemory pushRemappableOop: class. "may cause GC!!"
> self createActualMessageTo: class.
> rclass := objectMemory popRemappableOop.
> messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
> ^ self lookupMethodInClass: rclass!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') -----
> makeDirEntryName: entryName size: entryNameSize
> createDate: createDate modDate: modifiedDate
> isDir: dirFlag fileSize: fileSize
>
> | modDateOop createDateOop nameString results |
> self var: 'entryName' type: 'char *'.
>
> "allocate storage for results, remapping newly allocated
> oops in case GC happens during allocation"
> objectMemory pushRemappableOop:
> (objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 5).
> objectMemory pushRemappableOop:
> (objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize)..
> objectMemory pushRemappableOop: (self positive32BitIntegerFor: createDate).
> objectMemory pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
>
> modDateOop := objectMemory popRemappableOop.
> createDateOop := objectMemory popRemappableOop.
> nameString := objectMemory popRemappableOop.
> results := objectMemory popRemappableOop.
>
> 1 to: entryNameSize do: [ :i |
> objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
> ].
>
> objectMemory storePointer: 0 ofObject: results withValue: nameString.
> objectMemory storePointer: 1 ofObject: results withValue: createDateOop.
> objectMemory storePointer: 2 ofObject: results withValue: modDateOop.
> dirFlag
> + ifTrue: [ objectMemory storePointer: 3 ofObject: results withValue: objectMemory getTrueObj ]
> + ifFalse: [ objectMemory storePointer: 3 ofObject: results withValue: objectMemory getFalseObj ].
> - ifTrue: [ objectMemory storePointer: 3 ofObject: results withValue: objectMemory trueObj ]
> - ifFalse: [ objectMemory storePointer: 3 ofObject: results withValue: objectMemory falseObj ].
> objectMemory storePointer: 4 ofObject: results
> withValue: (objectMemory integerObjectOf: fileSize).
> ^ results
> !
>
> Item was changed:
> ----- Method: InterpreterSimulator>>objectBefore: (in category 'testing') -----
> objectBefore: addr
> | oop prev |
> oop := objectMemory firstObject.
> + [oop < objectMemory getEndOfMemory] whileTrue: [
> - [oop < objectMemory endOfMemory] whileTrue: [
> prev := oop. "look here if debugging prev obj overlapping this one"
> oop := objectMemory objectAfter: oop.
> oop >= addr ifTrue: [^ prev]
> ]!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>openOn:extraMemory: (in category 'initialization') -----
> openOn: fileName extraMemory: extraBytes
> "InterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
>
> | f headerSize count oldBaseAddr bytesToShift swapBytes hasPlatformFloatOrdering |
> "open image file and read the header"
>
> ["begin ensure block..."
> f := FileStream readOnlyFileNamed: fileName.
> imageName := f fullName.
> f binary.
>
> swapBytes := self checkImageVersionFrom: f startingAt: 0.
> "This interpreter does not use native float word order. Clear bit 1of format number."
> imageFormatVersionNumber := imageFormatInitialVersion bitAnd: -2.
> "If bit 1 was set set in the image file header, float word order must be normalized."
> hasPlatformFloatOrdering := (imageFormatInitialVersion bitAnd: 1) = 1.
>
> headerSize := self nextLongFrom: f swap: swapBytes.
> + objectMemory setEndOfMemory: (self nextLongFrom: f swap: swapBytes). "first unused location in heap"
> - objectMemory endOfMemory: (self nextLongFrom: f swap: swapBytes). "first unused location in heap"
> oldBaseAddr := self nextLongFrom: f swap: swapBytes. "object memory base address of image"
> + objectMemory setSpecialObjectsOop: (self nextLongFrom: f swap: swapBytes).
> + objectMemory setLastHash: (self nextLongFrom: f swap: swapBytes). "Should be loaded from, and saved to the image header"
> + objectMemory getLastHash = 0 ifTrue: [objectMemory setLastHash: 999].
> - objectMemory specialObjectsOop: (self nextLongFrom: f swap: swapBytes).
> - objectMemory lastHash: (self nextLongFrom: f swap: swapBytes). "Should be loaded from, and saved to the image header"
> - objectMemory lastHash = 0 ifTrue: [objectMemory lastHash: 999].
>
> savedWindowSize := self nextLongFrom: f swap: swapBytes.
> fullScreenFlag := self oldFormatFullScreenFlag: (self nextLongFrom: f swap: swapBytes).
> extraVMMemory := self nextLongFrom: f swap: swapBytes.
>
> "allocate interpreter memory"
> + objectMemory setMemoryLimit: (objectMemory getEndOfMemory + extraBytes).
> - objectMemory memoryLimit: (objectMemory endOfMemory + extraBytes).
>
> "read in the image in bulk, then swap the bytes if necessary"
> f position: headerSize.
> + objectMemory setMemory: (Bitmap new: objectMemory getMemoryLimit // 4).
> + count := f readInto: objectMemory getMemory startingAt: 1 count: objectMemory getEndOfMemory // 4.
> + count ~= (objectMemory getEndOfMemory // 4) ifTrue: [self halt].
> - objectMemory memory: (Bitmap new: objectMemory memoryLimit // 4).
> - count := f readInto: objectMemory memory startingAt: 1 count: objectMemory endOfMemory // 4.
> - count ~= (objectMemory endOfMemory // 4) ifTrue: [self halt].
> ]
> ensure: [f close].
>
> swapBytes ifTrue: [Utilities informUser: 'Swapping bytes of foreign image...'
> during: [self reverseBytesInImage]].
> self initialize.
> bytesToShift := 0 - oldBaseAddr. "adjust pointers for zero base address"
> + objectMemory setEndOfMemory: objectMemory getEndOfMemory.
> - objectMemory endOfMemory: objectMemory endOfMemory.
> Utilities informUser: 'Relocating object pointers...'
> during: [self initializeInterpreter: bytesToShift].
>
> hasPlatformFloatOrdering ifTrue: [
> "Low order bit set, indicating that the image was saved from
> a StackInterpreter (Cog) VM. Storage of all Float objects must be
> returned to older object memory format."
> Utilities informUser: 'Swapping words in float objects...'
> during: [self normalizeFloatOrderingInImage]].
> !
>
> Item was changed:
> ----- Method: InterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
> primitiveDirectoryLookup
> | index pathName array result |
> index := self stackIntegerValue: 0.
> pathName := (self stringOf: (self stackValue: 1)).
>
> self successful ifFalse: [
> ^self primitiveFail.
> ].
>
> array := FileDirectory default primLookupEntryIn: pathName index: index.
>
> array == nil ifTrue: [
> self pop: 3.
> + self push: objectMemory getNilObj.
> - self push: objectMemory nilObj.
> ^array.
> ].
> array == #badDirectoryPath ifTrue: [self halt.
> ^self primitiveFail.
> ].
>
> result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
> createDate: (array at: 2) modDate: (array at: 3)
> isDir: (array at: 4) fileSize: (array at: 5).
> self pop: 3.
> self push: result.
> !
>
> Item was changed:
> ----- Method: InterpreterSimulator>>primitiveKbdNext (in category 'I/O primitives') -----
> primitiveKbdNext
>
> self pop: 1.
> Sensor keyboardPressed
> ifTrue: [self pushInteger: Sensor primKbdNext]
> + ifFalse: [self push: objectMemory getNilObj]!
> - ifFalse: [self push: objectMemory nilObj]!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>primitiveKbdPeek (in category 'I/O primitives') -----
> primitiveKbdPeek
>
> self pop: 1.
> Sensor keyboardPressed
> ifTrue: [self pushInteger: Sensor primKbdPeek]
> + ifFalse: [self push: objectMemory getNilObj]!
> - ifFalse: [self push: objectMemory nilObj]!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>printStack: (in category 'debug support') -----
> printStack: includeTemps
> | ctxt |
> ctxt := activeContext.
> ^ String streamContents:
> [:strm |
> [self printStackFrame: ctxt onStream: strm.
> includeTemps ifTrue: [self printStackTemps: ctxt onStream: strm].
> + (ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory getNilObj]
> - (ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory nilObj]
> whileFalse: [].
> ]!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>printTop: (in category 'debug support') -----
> printTop: n
> "Print important fields of the top n contexts"
> | ctxt classAndSel home top ip sp |
> ctxt := activeContext.
> ^ String streamContents:
> [:strm | 1 to: n do:
> [:i |
> home := (objectMemory fetchClassOf: ctxt) = (objectMemory splObj: ClassBlockContext)
> ifTrue: [objectMemory fetchPointer: HomeIndex ofObject: ctxt]
> ifFalse: [ctxt].
> classAndSel := self
> classAndSelectorOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: home)
> forReceiver: (objectMemory fetchPointer: ReceiverIndex ofObject: home).
> strm cr; nextPutAll: ctxt hex8.
> ctxt = home ifFalse: [strm nextPutAll: ' [] in'].
> strm space; nextPutAll: (self nameOfClass: classAndSel first).
> strm nextPutAll: '>>'; nextPutAll: (self shortPrint: classAndSel last).
> ctxt = activeContext
> ifTrue: [ip := instructionPointer - method - (objectMemory baseHeaderSize - 2).
> sp := self stackPointerIndex - TempFrameStart + 1.
> top := self stackTop]
> ifFalse: [ip := objectMemory integerValueOf:
> (objectMemory fetchPointer: InstructionPointerIndex ofObject: ctxt).
> sp := objectMemory integerValueOf:
> (objectMemory fetchPointer: StackPointerIndex ofObject: ctxt).
> top := objectMemory longAt: ctxt + (objectMemory lastPointerOf: ctxt)].
> strm cr; tab; nextPutAll: 'ip = '; print: ip.
> strm cr; tab; nextPutAll: 'sp = '; print: sp.
> strm cr; tab; nextPutAll: 'top = '; nextPutAll: (self shortPrint: top).
> + (ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory getNilObj
> - (ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory nilObj
> ifTrue: [^strm contents].
> ].
> ]!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
> reverseBytesFrom: begin to: end
> "Byte-swap the given range of memory (not inclusive!!)."
> | wordAddr |
> wordAddr := begin.
> + objectMemory getMemory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
> - objectMemory memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>rewriteImageFileNamed: (in category 'image save/restore') -----
> rewriteImageFileNamed: fileName
> "Write an image file on a file named fileName using the window size that
> was provided by the original image file. This is intended for rewriting an
> image file that has been read from a disk file, but that has not yet been
> run in the interpreter. This may be used to load an image file that had been
> saved by another type of interpreter, and resaving it in the format used by
> this interpreter. For example, an image that has been saved as format 6505
> (indicating use of native float word ordering for a Cog VM) may be resaved
> in format 6504."
>
> "(InterpreterSimulator new openOn: Smalltalk imageName) rewriteImageFileNamed: 'newimagefile.image' "
>
> | file numberOfBytesToWrite |
> bytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
> + numberOfBytesToWrite := objectMemory getFreeBlock - objectMemory startOfMemory.
> - numberOfBytesToWrite := objectMemory freeBlock - objectMemory startOfMemory.
>
> [
> file := (FileStream fileNamed: fileName) binary.
> file == nil ifTrue: [^nil].
> Utilities informUser: 'Writing image to ''', fileName, '''...'
> during: [self writeImageFile: file size: numberOfBytesToWrite screenSize: savedWindowSize]
> ]
> ensure: [file close]!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>showDisplayBits:w:h:d:left:right:top:bottom: (in category 'I/O primitives') -----
> showDisplayBits: destBits w: w h: h d: d left: left right: right top: top bottom: bottom
> | raster pixPerWord simDisp realDisp rect |
> pixPerWord := 32 // d.
> raster := displayForm width + (pixPerWord - 1) // pixPerWord.
> + simDisp := Form new hackBits: objectMemory getMemory.
> - simDisp := Form new hackBits: objectMemory memory.
> displayForm unhibernate.
> realDisp := Form new hackBits: displayForm bits.
> realDisp
> copy: (0 @ (top * raster) extent: 4 @ (bottom - top * raster))
> from: 0 @ (destBits // 4 + (top * raster))
> in: simDisp
> rule: Form over.
> displayView ifNotNil: [^ displayView changed].
>
> "If running without a view, just blat the bits onto the screen..."
> rect := 0 @ top corner: displayForm width @ bottom.
> Display
> copy: (rect translateBy: self displayLocation)
> from: rect topLeft
> in: displayForm
> rule: Form over!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>stackDepth (in category 'testing') -----
> stackDepth
> | ctxt n |
> ctxt := activeContext.
> n := 0.
> + [(ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory getNilObj]
> - [(ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory nilObj]
> whileFalse: [n := n+1].
> ^ n!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>stats (in category 'testing') -----
> stats
> | oop fieldAddr fieldOop last stats v d |
> stats := Bag new.
> oop := objectMemory firstObject.
>
> 'Scanning the image...' displayProgressAt: Sensor cursorPoint
> + from: oop to: objectMemory getEndOfMemory
> - from: oop to: objectMemory endOfMemory
> during: [:bar |
>
> + [oop < objectMemory getEndOfMemory] whileTrue:
> - [oop < objectMemory endOfMemory] whileTrue:
> [(objectMemory isFreeObject: oop) ifFalse:
> [stats add: #objects.
> fieldAddr := oop + (objectMemory lastPointerOf: oop).
> [fieldAddr > oop] whileTrue:
> [fieldOop := objectMemory longAt: fieldAddr.
> (objectMemory isIntegerObject: fieldOop)
> ifTrue: [v := objectMemory integerValueOf: fieldOop.
> (v between: -16000 and: 16000)
> ifTrue: [stats add: #ints32k]
> ifFalse: [stats add: #intsOther]]
> + ifFalse: [fieldOop = objectMemory getNilObj ifTrue: [stats add: #nil]
> - ifFalse: [fieldOop = objectMemory nilObj ifTrue: [stats add: #nil]
> ifFalse:
> [d := fieldOop - oop.
> (d between: -16000 and: 16000)
> ifTrue: [stats add: #oops32k]
> ifFalse: [stats add: #oopsOther]]].
> fieldAddr := fieldAddr - bytesPerWord]].
> bar value: oop.
> last := oop.
> last := last.
> oop := objectMemory objectAfter: oop]].
> ^ stats sortedElements!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>storeAndPopReceiverVariableBytecode (in category 'bytecode routines') -----
> storeAndPopReceiverVariableBytecode
> "Note: This code uses storePointerUnchecked:ofObject:withValue: and does the store check explicitely in order to help the translator produce better code."
>
> "Interpreter version has fetchNextBytecode out of order"
> | rcvr top |
> rcvr := receiver.
> top := self internalStackTop.
> + (rcvr < objectMemory getYoungStart) ifTrue: [
> - (rcvr < objectMemory youngStart) ifTrue: [
> objectMemory possibleRootStoreInto: rcvr value: top.
> ].
> objectMemory storePointerUnchecked: (currentBytecode bitAnd: 7)
> ofObject: rcvr
> withValue: top.
> self internalPop: 1.
> self fetchNextBytecode.
> !
>
> Item was changed:
> ----- Method: InterpreterSimulator>>validOop: (in category 'testing') -----
> validOop: oop
> " Return true if oop appears to be valid "
> (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
> (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
> + oop >= objectMemory getEndOfMemory ifTrue: [^ false]. "Out of range"
> - oop >= objectMemory endOfMemory ifTrue: [^ false]. "Out of range"
> "could test if within the first large freeblock"
> (objectMemory longAt: oop) = 4 ifTrue: [^ false].
> (objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object"
> ^ true!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>validate (in category 'testing') -----
> validate
> | oop prev |
> transcript show: 'Validating...'.
> oop := objectMemory firstObject.
> + [oop < objectMemory getEndOfMemory] whileTrue: [
> - [oop < objectMemory endOfMemory] whileTrue: [
> self validate: oop.
> prev := oop. "look here if debugging prev obj overlapping this one"
> oop := objectMemory objectAfter: oop.
> ].
> prev := prev. "Don't offer to delete this please"
> transcript show: 'done.'; cr!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>validate: (in category 'testing') -----
> validate: oop
> | header type cc sz fmt nextChunk |
> header := objectMemory longAt: oop.
> type := header bitAnd: 3.
> type = 2 ifFalse: [type = (objectMemory rightType: header) ifFalse: [self halt]].
> sz := (header bitAnd: objectMemory sizeMask) >> 2.
> (objectMemory isFreeObject: oop)
> ifTrue: [ nextChunk := oop + (objectMemory sizeOfFree: oop) ]
> ifFalse: [ nextChunk := oop + (objectMemory sizeBitsOf: oop) ].
> + nextChunk > objectMemory getEndOfMemory
> + ifTrue: [oop = objectMemory getEndOfMemory ifFalse: [self halt]].
> - nextChunk > objectMemory endOfMemory
> - ifTrue: [oop = objectMemory endOfMemory ifFalse: [self halt]].
> (objectMemory headerType: nextChunk) = 0 ifTrue: [
> (objectMemory headerType: (nextChunk + (bytesPerWord * 2))) = 0 ifFalse: [self halt]].
> (objectMemory headerType: nextChunk) = 1 ifTrue: [
> (objectMemory headerType: (nextChunk + bytesPerWord)) = 1 ifFalse: [self halt]].
> type = 2 ifTrue:
> ["free block" ^ self].
> fmt := (header >> 8) bitAnd: 16rF.
> cc := (header >> 12) bitAnd: 31.
> cc > 16 ifTrue: [self halt]. "up to 32 are legal, but not used"
> type = 0 ifTrue:
> ["three-word header"
> ((objectMemory longAt: oop - bytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
> ((objectMemory longAt: oop-(bytesPerWord * 2)) bitAnd: 3) = type ifFalse: [self halt].
> ((objectMemory longAt: oop - bytesPerWord) = type) ifTrue: [self halt]. "Class word is 0"
> sz = 0 ifFalse: [self halt]].
> type = 1 ifTrue:
> ["two-word header"
> ((objectMemory longAt: oop - bytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
> cc > 0 ifTrue: [sz = 1 ifFalse: [self halt]].
> sz = 0 ifTrue: [self halt]].
> type = 3 ifTrue:
> ["one-word header"
> cc = 0 ifTrue: [self halt]].
> fmt = 5 ifTrue: [self halt].
> fmt = 7 ifTrue: [self halt].
> fmt >= 12 ifTrue:
> ["CompiledMethod -- check for integer header"
> (objectMemory isIntegerObject: (objectMemory longAt: oop + bytesPerWord)) ifFalse: [self halt]].!
>
> Item was changed:
> ----- Method: InterpreterSimulator>>writeImageFile:size:screenSize: (in category 'image save/restore') -----
> writeImageFile: file size: numberOfBytesToWrite screenSize: screenSize
> "Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
>
> | headerSize |
> objectMemory bytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
> headerSize := 16 * self bytesPerWord.
>
> {
> self imageFormatVersion.
> headerSize.
> numberOfBytesToWrite.
> objectMemory startOfMemory.
> + objectMemory getSpecialObjectsOop.
> + objectMemory getLastHash.
> - objectMemory specialObjectsOop.
> - objectMemory lastHash.
> screenSize.
> fullScreenFlag.
> extraVMMemory
> }
> do: [:long | self putLong: long toFile: file].
>
> "Pad the rest of the header."
> 7 timesRepeat: [self putLong: 0 toFile: file].
>
> "Position the file after the header."
> file position: headerSize.
>
> "Write the object memory."
> 1 to: numberOfBytesToWrite // 4
> do: [:index |
> self
> + putLong: (objectMemory getMemory at: index)
> - putLong: (objectMemory memory at: index)
> toFile: file].
>
> self success: true
> !
>
> Item was changed:
> ----- Method: InterpreterSimulator>>writeImageFileIO: (in category 'image save/restore') -----
> writeImageFileIO: numberOfBytesToWrite
> "Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
>
> | headerSize file |
> bytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
> headerSize := 16 * bytesPerWord.
>
> [
> file := (FileStream fileNamed: imageName) binary.
> file == nil ifTrue: [^nil].
>
> {
> self imageFormatVersion.
> headerSize.
> numberOfBytesToWrite.
> objectMemory startOfMemory.
> + objectMemory getSpecialObjectsOop.
> + objectMemory getLastHash.
> - objectMemory specialObjectsOop.
> - objectMemory lastHash.
> self ioScreenSize.
> fullScreenFlag.
> extraVMMemory
> }
> do: [:long | self putLong: long toFile: file].
>
> "Pad the rest of the header."
> 7 timesRepeat: [self putLong: 0 toFile: file].
>
> "Position the file after the header."
> file position: headerSize.
>
> "Write the object memory."
> 1
> to: numberOfBytesToWrite // 4
> do: [:index |
> self
> + putLong: (objectMemory getMemory at: index)
> - putLong: (objectMemory memory at: index)
> toFile: file].
>
> self success: true
> ]
> ensure: [file close]!
>
> Item was changed:
> ----- Method: InterpreterSimulatorLSB>>displayForm: (in category 'debug support') -----
> displayForm: f
> | width height depth bits realForm simDisp realDisp |
> bits := objectMemory fetchPointer: 0 ofObject: f.
> width := self fetchInteger: 1 ofObject: f.
> height := self fetchInteger: 2 ofObject: f.
> depth := self fetchInteger: 3 ofObject: f.
> realForm := Form extent: width@height depth: depth.
> + simDisp := Form new hackBits: objectMemory getMemory.
> - simDisp := Form new hackBits: objectMemory memory.
> realDisp := Form new hackBits: realForm bits.
> realDisp
> copy: (0 @ 0 extent: 4 @ realForm bits size)
> from: (0 @ (bits + 4 // 4))
> in: simDisp
> rule: Form over.
> realForm displayOn: Display at: 0@0.!
>
> Item was removed:
> - ----- Method: NewObjectMemory>>edenBytes: (in category 'accessing') -----
> - edenBytes: aValue
> - ^edenBytes := aValue!
>
> Item was removed:
> - ----- Method: NewObjectMemory>>falseObject: (in category 'accessing') -----
> - falseObject: anOop
> - "For mapInterpreterOops"
> - falseObj := anOop!
>
> Item was removed:
> - ----- Method: NewObjectMemory>>freeStart: (in category 'accessing') -----
> - freeStart: aValue
> - ^freeStart := aValue!
>
> Item was added:
> + ----- Method: NewObjectMemory>>getYoungStart (in category 'cog jit support') -----
> + getYoungStart
> + <cmacro: '() GIV(youngStart)'>
> + <returnTypeC: #usqInt>
> + ^youngStart!
>
> Item was removed:
> - ----- Method: NewObjectMemory>>heapMapAtWord: (in category 'debug printing') -----
> - heapMapAtWord: wordPointer
> - "Implemented in support code for Cog branch in Cross/vm/sqHeapMap.c and
> - stubbed out here for use with trunk platform sources"
> -
> - self flag: #FIXME. "remove this method and add sqHeapMap.c to Cross when 64 bit address space can be supported"
> - ^ 1
> -
> - "
> - /*
> - * Answer non-zero if the heapMap is set at wordPointer, 0 otherwise
> - */
> - int heapMapAtWord(void *wordPointer)
> - { . . . }
> - "!
>
> Item was removed:
> - ----- Method: NewObjectMemory>>needGCFlag: (in category 'accessing') -----
> - needGCFlag: aValue
> - ^needGCFlag := aValue!
>
> Item was changed:
> ----- Method: NewObjectMemory>>postGCAction: (in category 'garbage collection') -----
> postGCAction: fullGCFlag
> "Shrink free memory and signal the gc semaphore."
> | freeSizeNow |
>
> freeSizeNow := self freeSize.
> + (freeSizeNow > self getShrinkThreshold
> + and: [freeSizeNow > self getGrowHeadroom]) ifTrue:
> - (freeSizeNow > self shrinkThreshold
> - and: [freeSizeNow > self growHeadroom]) ifTrue:
> ["Attempt to shrink memory after successfully reclaiming lots of memory"
> + self shrinkObjectMemory: freeSizeNow - self getGrowHeadroom].
> - self shrinkObjectMemory: freeSizeNow - self growHeadroom].
>
> + interpreter signalSemaphoreWithIndex: self getGcSemaphoreIndex!
> - interpreter signalSemaphoreWithIndex: self gcSemaphoreIndex!
>
> Item was added:
> + ----- Method: NewObjectMemory>>setEdenBytes: (in category 'accessing') -----
> + setEdenBytes: aValue
> + ^edenBytes := aValue!
>
> Item was added:
> + ----- Method: NewObjectMemory>>setFalseObject: (in category 'accessing') -----
> + setFalseObject: anOop
> + "For mapInterpreterOops"
> + falseObj := anOop!
>
> Item was added:
> + ----- Method: NewObjectMemory>>setFreeStart: (in category 'accessing') -----
> + setFreeStart: aValue
> + ^freeStart := aValue!
>
> Item was added:
> + ----- Method: NewObjectMemory>>setNeedGCFlag: (in category 'accessing') -----
> + setNeedGCFlag: aValue
> + ^needGCFlag := aValue!
>
> Item was added:
> + ----- Method: NewObjectMemory>>setTrueObject: (in category 'accessing') -----
> + setTrueObject: anOop
> + "For mapInterpreterOops"
> + trueObj := anOop!
>
> Item was changed:
> + ----- Method: NewObjectMemory>>startOfFreeSpace (in category 'accessing') -----
> - ----- Method: NewObjectMemory>>startOfFreeSpace (in category 'memory access') -----
> startOfFreeSpace
> + <returnTypeC: #usqInt>
> - <inline: true>
> ^freeStart!
>
> Item was removed:
> - ----- Method: NewObjectMemory>>trueObject: (in category 'accessing') -----
> - trueObject: anOop
> - "For mapInterpreterOops"
> - trueObj := anOop!
>
> Item was removed:
> - ----- Method: NewObjectMemory>>youngStart (in category 'cog jit support') -----
> - youngStart
> - <cmacro: '() GIV(youngStart)'>
> - ^youngStart!
>
> Item was added:
> + ----- Method: NewObjectMemorySimulator>>setHeaderTypeBytes: (in category 'initialization') -----
> + setHeaderTypeBytes: array
> + headerTypeBytes := array!
>
> Item was added:
> + ----- Method: NewObjectMemorySimulator>>setInterpreter: (in category 'initialization') -----
> + setInterpreter: anInterpreter
> + interpreter := anInterpreter!
>
> Item was added:
> + ----- Method: NewObjectMemorySimulator>>setRemapBuffer: (in category 'initialization') -----
> + setRemapBuffer: table
> + remapBuffer := table!
>
> Item was added:
> + ----- Method: NewObjectMemorySimulator>>setRootTable: (in category 'initialization') -----
> + setRootTable: table
> + rootTable := table!
>
> Item was added:
> + ----- Method: NewObjectMemorySimulator>>setWeakRoots: (in category 'initialization') -----
> + setWeakRoots: table
> + weakRoots := table!
>
> Item was changed:
> ----- Method: NewObjectMemorySimulator>>sqGrowMemory:By: (in category 'memory access') -----
> sqGrowMemory: oldLimit By: delta
> | newMemory |
> coInterpreter transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr.
> memory size * 4 < (oldLimit + delta) ifTrue:
> [newMemory := (memory class new: oldLimit + delta + 3 // 4).
> newMemory replaceFrom: 1 to: memory size with: memory startingAt: 1.
> + coInterpreter setMemory: (memory := newMemory)].
> - coInterpreter memory: (memory := newMemory)].
> ^memory size * 4!
>
> Item was changed:
> VMClass subclass: #ObjectMemory
> + instanceVariableNames: 'interpreter memory youngStart endOfMemory memoryLimit nilObj falseObj trueObj specialObjectsOop rootTable rootTableCount extraRoots extraRootCount weakRoots weakRootCount child field parentField freeBlock lastHash allocationCount lowSpaceThreshold signalLowSpace compStart compEnd fwdTableNext fwdTableLast remapBuffer remapBufferCount allocationsBetweenGCs tenuringThreshold gcSemaphoreIndex gcBiasToGrow gcBiasToGrowGCLimit gcBiasToGrowThreshold statFullGCs statFullGCMSecs statFullGCUsecs statIncrGCs statIncrGCMSecs statIncrGCUsecs statIGCDeltaUsecs statTenures statRootTableOverflows freeContexts freeLargeContexts totalObjectCount shrinkThreshold growHeadroom headerTypeBytes youngStartLocal statMarkCount statSweepCount statMkFwdCount statCompMoveCount statGrowMemory statShrinkMemory statRootTableCount statAllocationCount statSurvivorCount statGCTime statSpecialMarkCount statIGCDeltaTime statpendingFinalizationSignals forceTenureFlag gcStartUsecs rootTableOverflowed'
> - instanceVariableNames: 'interpreter memory youngStart endOfMemory memoryLimit nilObj falseObj trueObj specialObjectsOop rootTable rootTableCount extraRoots extraRootCount weakRoots weakRootCount child field parentField freeBlock lastHash allocationCount lowSpaceThreshold signalLowSpace compStart compEnd fwdTableNext fwdTableLast remapBuffer remapBufferCount allocationsBetweenGCs tenuringThreshold gcSemaphoreIndex gcBiasToGrow gcBiasToGrowGCLimit gcBiasToGrowThreshold statFullGCs statFullGCMSecs statFullGCUsecs statIncrGCs statIncrGCMSecs statIncrGCUsecs statIGCDeltaUsecs statTenures statRootTableOverflows freeContexts freeLargeContexts totalObjectCount shrinkThreshold growHeadroom headerTypeBytes youngStartLocal statMarkCount statSweepCount statMkFwdCount statCompMoveCount statGrowMemory statShrinkMemory statRootTableCount statAllocationCount statSurvivorCount statGCTime statSpecialMarkCount statIGCDeltaTime statpendingFinalizationSignals forceTenureFlag gcStartUsecs'
> classVariableNames: 'Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask ClassPseudoContext ClassTranslatedMethod ContextFixedSizePlusHeader Done ExtraRootSize GCTopMarker HashBits HeaderTypeClass HeaderTypeFree HeaderTypeGC InvokeCallbackSelector NilContext RemapBufferSize RootTableRedZone RootTableSize StartField StartObj Upward'
> poolDictionaries: 'VMBasicConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants'
> category: 'VMMaker-Interpreter'!
>
> !ObjectMemory commentStamp: '<historical>' prior: 0!
> This class describes a 32-bit direct-pointer object memory for Smalltalk. The model is very simple in principle: a pointer is either a SmallInteger or a 32-bit direct object pointer.
>
> SmallIntegers are tagged with a low-order bit equal to 1, and an immediate 31-bit 2s-complement signed value in the rest of the word.
>
> All object pointers point to a header, which may be followed by a number of data fields. This object memory achieves considerable compactness by using a variable header size (the one complexity of the design). The format of the 0th header word is as follows:
>
> 3 bits reserved for gc (mark, root, unused)
> 12 bits object hash (for HashSets)
> 5 bits compact class index
> 4 bits object format
> 6 bits object size in 32-bit words
> 2 bits header type (0: 3-word, 1: 2-word, 2: forbidden, 3: 1-word)
>
> If a class is in the compact class table, then this is the only header information needed. If it is not, then it will have another header word at offset -4 bytes with its class in the high 30 bits, and the header type repeated in its low 2 bits. It the objects size is greater than 255 bytes, then it will have yet another header word at offset -8 bytes with its full word size in the high 30 bits and its header type repeated in the low two bits.
>
> The object format field provides the remaining information as given in the formatOf: method (including isPointers, isVariable, isBytes, and the low 2 size bits of byte-sized objects).
>
> This implementation includes incremental (2-generation) and full garbage collection, each with compaction and rectification of direct pointers. It also supports a bulk-become (exchange object identity) feature that allows many objects to be becomed at once, as when all instances of a class must be grown or shrunk.
>
> There is now a simple 64-bit version of the object memory. It is the simplest possible change that could work. It merely sign-extends all integer oops, and extends all object headers and oops by adding 32 zeroes in the high bits. The format of the base header word is changed in one minor, not especially elegant, way. Consider the old 32-bit header:
> ggghhhhhhhhhhhhcccccffffsssssstt
> The 64-bit header is almost identical, except that the size field (now being in units of 8 bytes, has a zero in its low-order bit. At the same time, the byte-size residue bits for byte objects, which are in the low order bits of formats 8-11 and 12-15, are now in need of another bit of residue. So, the change is as follows:
> ggghhhhhhhhhhhhcccccffffsssssrtt
> where bit r supplies the 4's bit of the byte size residue for byte objects. Oh, yes, this is also needed now for 'variableWord' objects, since their size in 32-bit words requires a low-order bit.
>
> See the comment in formatOf: for the change allowing for 64-bit wide bitmaps, now dubbed 'variableLong'.!
>
> Item was removed:
> - ----- Method: ObjectMemory>>allocationsBetweenGCs (in category 'accessing') -----
> - allocationsBetweenGCs
> - ^allocationsBetweenGCs!
>
> Item was removed:
> - ----- Method: ObjectMemory>>allocationsBetweenGCs: (in category 'accessing') -----
> - allocationsBetweenGCs: count
> - allocationsBetweenGCs := count!
>
> Item was changed:
> ----- Method: ObjectMemory>>checkHeapIntegrity (in category 'memory access') -----
> checkHeapIntegrity
> "Perform an integrity/leak check using the heapMap. Assume
> clearLeakMapAndMapAccessibleObjects has set a bit at each
> object's header. Scan all objects in the heap checking that every
> pointer points to a header. Scan the rootTable, remapBuffer and
> extraRootTable checking that every entry is a pointer to a header.
> Check that the number of roots is correct and that all rootTable
> entries have their rootBit set. Answer if all checks pass."
> | ok obj sz hdr fmt fi fieldOop numRootsInHeap |
> <inline: false>
> ok := true.
> numRootsInHeap := 0.
> obj := self firstObject.
> [self oop: obj isLessThan: self startOfFreeSpace] whileTrue:
> [(self isFreeObject: obj)
> ifTrue:
> [sz := self sizeOfFree: obj]
> ifFalse:
> [hdr := self baseHeader: obj.
> + (self isYoungRootHeader: hdr) ifTrue:
> - (hdr bitAnd: self rootBit) ~= 0 ifTrue:
> [numRootsInHeap := numRootsInHeap + 1].
> (self compactClassIndexOfHeader: hdr) = 0 ifTrue:
> [fieldOop := (self classHeader: obj) bitAnd: self allButTypeMask.
> ((self isIntegerObject: fieldOop)
> or: [(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
> [self print: 'object leak in '; printHex: obj; print: ' class = '; printHex: fieldOop; cr.
> ok := false]].
> fmt := self formatOfHeader: hdr.
> + (fmt <= self lastPointerFormat or: [fmt >= self firstCompiledMethodFormat]) ifTrue:
> + [fmt >= self firstCompiledMethodFormat
> + ifTrue: [fi := (self literalCountOf: obj) + LiteralStart]
> + ifFalse: [(fmt = self indexablePointersFormat and: [self isContextHeader: hdr])
> - (fmt <= 4 "pointers" or: [fmt >= 12 "compiled method"]) ifTrue:
> - [fmt >= 12
> - ifTrue: [fi := (self literalCountOf: obj) + 1 "+ 1 = methodHeader slot"]
> - ifFalse: [(fmt = 3 and: [self isContextHeader: hdr])
> ifTrue: [fi := CtxtTempFrameStart + (self fetchStackPointerOf: obj)]
> ifFalse: [fi := self lengthOf: obj]].
> [(fi := fi - 1) >= 0] whileTrue:
> [fieldOop := self fetchPointer: fi ofObject: obj.
> (self isNonIntegerObject: fieldOop) ifTrue:
> [(fieldOop bitAnd: self bytesPerWord - 1) ~= 0
> ifTrue:
> [self print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
> ok := false]
> ifFalse:
> [(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
> [self print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
> ok := false]]]]].
> sz := self sizeBitsOf: obj].
> obj := self oopFromChunk: obj + sz].
> numRootsInHeap ~= rootTableCount ifTrue:
> [self print: 'root count mismatch. #heap roots '; printNum: numRootsInHeap; print: '; #roots '; printNum: rootTableCount; cr.
> + "But the system copes with overflow..."
> + ok := rootTableOverflowed and: [allocationCount > allocationsBetweenGCs]].
> - ok := false].
> 1 to: rootTableCount do:
> [:ri|
> obj := rootTable at: ri.
> (obj bitAnd: self bytesPerWord - 1) ~= 0
> ifTrue:
> [self print: 'misaligned oop in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
> ok := false]
> ifFalse:
> [(self heapMapAtWord: (self pointerForOop: obj)) = 0
> ifTrue:
> [self print: 'object leak in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
> ok := false]
> ifFalse:
> [hdr := self baseHeader: obj.
> + (self isYoungRootHeader: hdr) ifFalse:
> - (hdr bitAnd: self rootBit) = 0 ifTrue:
> [self print: 'non-root in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
> ok := false]]]].
> 1 to: remapBufferCount do:
> [:ri|
> obj := remapBuffer at: ri.
> (obj bitAnd: self bytesPerWord - 1) ~= 0
> ifTrue:
> [self print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
> ok := false]
> ifFalse:
> [(self heapMapAtWord: (self pointerForOop: obj)) = 0
> ifTrue:
> [self print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
> ok := false]]].
> 1 to: extraRootCount do:
> [:ri|
> obj := (extraRoots at: ri) at: 0.
> (obj bitAnd: self bytesPerWord - 1) ~= 0
> ifTrue:
> [self print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
> ok := false]
> ifFalse:
> [(self heapMapAtWord: (self pointerForOop: obj)) = 0
> ifTrue:
> [self print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
> ok := false]]].
> ^ok!
>
> Item was removed:
> - ----- Method: ObjectMemory>>endOfMemory (in category 'accessing') -----
> - endOfMemory
> - "Simulation support"
> - ^endOfMemory!
>
> Item was removed:
> - ----- Method: ObjectMemory>>endOfMemory: (in category 'accessing') -----
> - endOfMemory: position
> - "Simulation support"
> - endOfMemory := position!
>
> Item was removed:
> - ----- Method: ObjectMemory>>falseObj (in category 'accessing') -----
> - falseObj
> - ^falseObj!
>
> Item was removed:
> - ----- Method: ObjectMemory>>falseObj: (in category 'accessing') -----
> - falseObj: oop
> - falseObj := oop!
>
> Item was added:
> + ----- Method: ObjectMemory>>firstCompiledMethodFormat (in category 'header formats') -----
> + firstCompiledMethodFormat
> + <api>
> + ^12!
>
> Item was removed:
> - ----- Method: ObjectMemory>>forceTenureFlag: (in category 'accessing') -----
> - forceTenureFlag: arg
> - forceTenureFlag := arg!
>
> Item was removed:
> - ----- Method: ObjectMemory>>freeBlock (in category 'accessing') -----
> - freeBlock
> - ^freeBlock!
>
> Item was removed:
> - ----- Method: ObjectMemory>>freeContexts (in category 'accessing') -----
> - freeContexts
> - ^freeContexts!
>
> Item was removed:
> - ----- Method: ObjectMemory>>freeContexts: (in category 'accessing') -----
> - freeContexts: arg
> - freeContexts := arg!
>
> Item was removed:
> - ----- Method: ObjectMemory>>freeLargeContexts: (in category 'accessing') -----
> - freeLargeContexts: arg
> - freeLargeContexts := arg!
>
> Item was removed:
> - ----- Method: ObjectMemory>>gcBiasToGrow: (in category 'accessing') -----
> - gcBiasToGrow: arg
> - gcBiasToGrow := arg!
>
> Item was removed:
> - ----- Method: ObjectMemory>>gcSemaphoreIndex (in category 'accessing') -----
> - gcSemaphoreIndex
> - ^gcSemaphoreIndex!
>
> Item was removed:
> - ----- Method: ObjectMemory>>gcSemaphoreIndex: (in category 'accessing') -----
> - gcSemaphoreIndex: index
> - gcSemaphoreIndex := index!
>
> Item was added:
> + ----- Method: ObjectMemory>>getAllocationsBetweenGCs (in category 'accessing') -----
> + getAllocationsBetweenGCs
> + ^allocationsBetweenGCs!
>
> Item was added:
> + ----- Method: ObjectMemory>>getEndOfMemory (in category 'accessing') -----
> + getEndOfMemory
> + <returnTypeC: #usqInt>
> + ^endOfMemory!
>
> Item was added:
> + ----- Method: ObjectMemory>>getFalseObj (in category 'accessing') -----
> + getFalseObj
> + ^falseObj!
>
> Item was added:
> + ----- Method: ObjectMemory>>getFreeBlock (in category 'accessing') -----
> + getFreeBlock
> + <returnTypeC: #usqInt>
> + ^freeBlock!
>
> Item was added:
> + ----- Method: ObjectMemory>>getFreeContexts (in category 'accessing') -----
> + getFreeContexts
> + ^freeContexts!
>
> Item was added:
> + ----- Method: ObjectMemory>>getGcSemaphoreIndex (in category 'accessing') -----
> + getGcSemaphoreIndex
> + ^gcSemaphoreIndex!
>
> Item was added:
> + ----- Method: ObjectMemory>>getGrowHeadroom (in category 'accessing') -----
> + getGrowHeadroom
> + ^growHeadroom!
>
> Item was added:
> + ----- Method: ObjectMemory>>getLastHash (in category 'accessing') -----
> + getLastHash
> + "Simulation support"
> + ^lastHash!
>
> Item was added:
> + ----- Method: ObjectMemory>>getMemory (in category 'accessing') -----
> + getMemory
> + <returnTypeC: #usqInt>
> + ^memory!
>
> Item was added:
> + ----- Method: ObjectMemory>>getMemoryLimit (in category 'accessing') -----
> + getMemoryLimit
> + "Simulation support"
> + <returnTypeC: #usqInt>
> + ^memoryLimit!
>
> Item was added:
> + ----- Method: ObjectMemory>>getNilObj (in category 'accessing') -----
> + getNilObj
> + ^nilObj!
>
> Item was added:
> + ----- Method: ObjectMemory>>getRemapBufferCount (in category 'accessing') -----
> + getRemapBufferCount
> + ^remapBufferCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>getRootTableCount (in category 'accessing') -----
> + getRootTableCount
> + ^rootTableCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>getShrinkThreshold (in category 'accessing') -----
> + getShrinkThreshold
> + <returnTypeC: #usqInt>
> + ^shrinkThreshold!
>
> Item was added:
> + ----- Method: ObjectMemory>>getSignalLowSpace (in category 'accessing') -----
> + getSignalLowSpace
> + ^signalLowSpace!
>
> Item was added:
> + ----- Method: ObjectMemory>>getSpecialObjectsOop (in category 'accessing') -----
> + getSpecialObjectsOop
> + "Simulation support"
> + ^specialObjectsOop!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatAllocationCount (in category 'accessing') -----
> + getStatAllocationCount
> + ^statAllocationCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatCompMoveCount (in category 'accessing') -----
> + getStatCompMoveCount
> + ^statCompMoveCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatFullGCMSecs (in category 'accessing') -----
> + getStatFullGCMSecs
> + ^statFullGCMSecs!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatFullGCs (in category 'accessing') -----
> + getStatFullGCs
> + ^statFullGCs!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatGCTime (in category 'accessing') -----
> + getStatGCTime
> + ^statGCTime!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatGrowMemory (in category 'accessing') -----
> + getStatGrowMemory
> + ^statGrowMemory!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatIGCDeltaTime (in category 'accessing') -----
> + getStatIGCDeltaTime
> + ^statIGCDeltaTime!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatIncrGCMSecs (in category 'accessing') -----
> + getStatIncrGCMSecs
> + ^statIncrGCMSecs!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatIncrGCs (in category 'accessing') -----
> + getStatIncrGCs
> + ^statIncrGCs!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatMarkCount (in category 'accessing') -----
> + getStatMarkCount
> + ^statMarkCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatMkFwdCount (in category 'accessing') -----
> + getStatMkFwdCount
> + ^statMkFwdCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatRootTableCount (in category 'accessing') -----
> + getStatRootTableCount
> + ^statRootTableCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatRootTableOverflows (in category 'accessing') -----
> + getStatRootTableOverflows
> + ^statRootTableOverflows!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatShrinkMemory (in category 'accessing') -----
> + getStatShrinkMemory
> + ^statShrinkMemory!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatSpecialMarkCount (in category 'accessing') -----
> + getStatSpecialMarkCount
> + ^statSpecialMarkCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatSurvivorCount (in category 'accessing') -----
> + getStatSurvivorCount
> + ^statSurvivorCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatSweepCount (in category 'accessing') -----
> + getStatSweepCount
> + ^statSweepCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatTenures (in category 'accessing') -----
> + getStatTenures
> + ^statTenures!
>
> Item was added:
> + ----- Method: ObjectMemory>>getStatpendingFinalizationSignals (in category 'accessing') -----
> + getStatpendingFinalizationSignals
> + ^statpendingFinalizationSignals!
>
> Item was added:
> + ----- Method: ObjectMemory>>getTenuringThreshold (in category 'accessing') -----
> + getTenuringThreshold
> + ^tenuringThreshold!
>
> Item was added:
> + ----- Method: ObjectMemory>>getTrueObj (in category 'accessing') -----
> + getTrueObj
> + ^trueObj!
>
> Item was added:
> + ----- Method: ObjectMemory>>getYoungStart (in category 'accessing') -----
> + getYoungStart
> + <returnTypeC: #usqInt>
> + self subclassResponsibility!
>
> Item was removed:
> - ----- Method: ObjectMemory>>growHeadroom (in category 'accessing') -----
> - growHeadroom
> - ^growHeadroom!
>
> Item was removed:
> - ----- Method: ObjectMemory>>growHeadroom: (in category 'accessing') -----
> - growHeadroom: arg
> - growHeadroom := arg!
>
> Item was removed:
> - ----- Method: ObjectMemory>>headerTypeBytes (in category 'accessing') -----
> - headerTypeBytes
> - ^headerTypeBytes!
>
> Item was removed:
> - ----- Method: ObjectMemory>>headerTypeBytes: (in category 'accessing') -----
> - headerTypeBytes: array
> - "Simulation support"
> - headerTypeBytes := array!
>
> Item was added:
> + ----- Method: ObjectMemory>>headerTypeBytesAt:put: (in category 'accessing') -----
> + headerTypeBytesAt: index put: value
> + headerTypeBytes at: index put: value!
>
> Item was removed:
> - ----- Method: ObjectMemory>>headerTypeClass (in category 'accessing') -----
> - headerTypeClass
> - ^HeaderTypeClass!
>
> Item was added:
> + ----- Method: ObjectMemory>>heapMapAtWord: (in category 'debug printing') -----
> + heapMapAtWord: wordPointer
> + "Implemented in support code for Cog branch in Cross/vm/sqHeapMap.c and
> + stubbed out here for use with trunk platform sources"
> +
> + self flag: #FIXME. "remove this method and add sqHeapMap.c to Cross when 64 bit address space can be supported"
> + ^ 1
> +
> + "
> + /*
> + * Answer non-zero if the heapMap is set at wordPointer, 0 otherwise
> + */
> + int heapMapAtWord(void *wordPointer)
> + { . . . }
> + "!
>
> Item was added:
> + ----- Method: ObjectMemory>>indexablePointersFormat (in category 'header formats') -----
> + indexablePointersFormat
> + <api>
> + ^3!
>
> Item was removed:
> - ----- Method: ObjectMemory>>interpreter: (in category 'accessing') -----
> - interpreter: anInterpreter
> - interpreter := anInterpreter!
>
> Item was added:
> + ----- Method: ObjectMemory>>isYoungRootHeader: (in category 'garbage collection') -----
> + isYoungRootHeader: header
> + "Answer if oop is a root for objects in youngSpace"
> + ^(header bitAnd: self rootBit) ~= 0!
>
> Item was removed:
> - ----- Method: ObjectMemory>>lastHash (in category 'accessing') -----
> - lastHash
> - "Simulation support"
> - ^lastHash!
>
> Item was removed:
> - ----- Method: ObjectMemory>>lastHash: (in category 'accessing') -----
> - lastHash: hash
> - "Simulation support"
> - lastHash := hash!
>
> Item was added:
> + ----- Method: ObjectMemory>>lastPointerFormat (in category 'header access') -----
> + lastPointerFormat
> + "N.B. 5 is unused and could be used for ephemerons.
> + 7 is unused and could be used for 64-bit indexable."
> + ^4!
>
> Item was removed:
> - ----- Method: ObjectMemory>>lowSpaceThreshold: (in category 'accessing') -----
> - lowSpaceThreshold: arg
> - lowSpaceThreshold := arg!
>
> Item was removed:
> - ----- Method: ObjectMemory>>memory (in category 'accessing') -----
> - memory
> - ^memory!
>
> Item was removed:
> - ----- Method: ObjectMemory>>memory: (in category 'accessing') -----
> - memory: loc
> - memory := loc!
>
> Item was removed:
> - ----- Method: ObjectMemory>>memoryLimit (in category 'accessing') -----
> - memoryLimit
> - "Simulation support"
> - ^memoryLimit!
>
> Item was removed:
> - ----- Method: ObjectMemory>>memoryLimit: (in category 'accessing') -----
> - memoryLimit: limit
> - "Simulation support"
> - memoryLimit := limit!
>
> Item was removed:
> - ----- Method: ObjectMemory>>nilObj (in category 'accessing') -----
> - nilObj
> - ^nilObj!
>
> Item was removed:
> - ----- Method: ObjectMemory>>nilObj: (in category 'accessing') -----
> - nilObj: oop
> - nilObj := oop!
>
> Item was removed:
> - ----- Method: ObjectMemory>>remapBuffer (in category 'accessing') -----
> - remapBuffer
> - ^remapBuffer!
>
> Item was removed:
> - ----- Method: ObjectMemory>>remapBuffer: (in category 'accessing') -----
> - remapBuffer: table
> - "Simulation support"
> - remapBuffer := table!
>
> Item was added:
> + ----- Method: ObjectMemory>>remapBufferAt: (in category 'accessing') -----
> + remapBufferAt: index
> + ^remapBuffer at: index!
>
> Item was added:
> + ----- Method: ObjectMemory>>remapBufferAt:put: (in category 'accessing') -----
> + remapBufferAt: index put: value
> + remapBuffer at: index put: value!
>
> Item was removed:
> - ----- Method: ObjectMemory>>remapBufferCount (in category 'accessing') -----
> - remapBufferCount
> - ^remapBufferCount!
>
> Item was removed:
> - ----- Method: ObjectMemory>>rootTable (in category 'accessing') -----
> - rootTable
> - ^rootTable!
>
> Item was removed:
> - ----- Method: ObjectMemory>>rootTable: (in category 'accessing') -----
> - rootTable: table
> - "Simulation support"
> - rootTable := table!
>
> Item was added:
> + ----- Method: ObjectMemory>>rootTableAt: (in category 'accessing') -----
> + rootTableAt: index
> + ^rootTable at: index!
>
> Item was removed:
> - ----- Method: ObjectMemory>>rootTableCount (in category 'accessing') -----
> - rootTableCount
> - ^rootTableCount!
>
> Item was added:
> + ----- Method: ObjectMemory>>setAllocationsBetweenGCs: (in category 'accessing') -----
> + setAllocationsBetweenGCs: count
> + allocationsBetweenGCs := count!
>
> Item was changed:
> + ----- Method: ObjectMemory>>setEndOfMemory: (in category 'accessing') -----
> + setEndOfMemory: position
> + "Simulation support"
> + endOfMemory := position!
> - ----- Method: ObjectMemory>>setEndOfMemory: (in category 'initialization') -----
> - setEndOfMemory: newEndOfMemory
> - self assert: (newEndOfMemory bitAnd: self bytesPerWord - 1) = 0.
> - endOfMemory := newEndOfMemory!
>
> Item was added:
> + ----- Method: ObjectMemory>>setForceTenureFlag: (in category 'accessing') -----
> + setForceTenureFlag: arg
> + forceTenureFlag := arg!
>
> Item was added:
> + ----- Method: ObjectMemory>>setFreeContexts: (in category 'accessing') -----
> + setFreeContexts: arg
> + freeContexts := arg!
>
> Item was added:
> + ----- Method: ObjectMemory>>setFreeLargeContexts: (in category 'accessing') -----
> + setFreeLargeContexts: arg
> + freeLargeContexts := arg!
>
> Item was added:
> + ----- Method: ObjectMemory>>setGcBiasToGrow: (in category 'accessing') -----
> + setGcBiasToGrow: arg
> + gcBiasToGrow := arg!
>
> Item was added:
> + ----- Method: ObjectMemory>>setGcSemaphoreIndex: (in category 'accessing') -----
> + setGcSemaphoreIndex: index
> + gcSemaphoreIndex := index!
>
> Item was added:
> + ----- Method: ObjectMemory>>setGrowHeadroom: (in category 'accessing') -----
> + setGrowHeadroom: arg
> + growHeadroom := arg!
>
> Item was added:
> + ----- Method: ObjectMemory>>setLastHash: (in category 'accessing') -----
> + setLastHash: hash
> + "Simulation support"
> + lastHash := hash!
>
> Item was added:
> + ----- Method: ObjectMemory>>setLowSpaceThreshold: (in category 'accessing') -----
> + setLowSpaceThreshold: arg
> + lowSpaceThreshold := arg!
>
> Item was added:
> + ----- Method: ObjectMemory>>setMemory: (in category 'accessing') -----
> + setMemory: loc
> + memory := loc!
>
> Item was changed:
> + ----- Method: ObjectMemory>>setMemoryLimit: (in category 'accessing') -----
> + setMemoryLimit: limit
> + "Simulation support"
> + memoryLimit := limit!
> - ----- Method: ObjectMemory>>setMemoryLimit: (in category 'initialization') -----
> - setMemoryLimit: newMemoryLimit
> - self assert: (newMemoryLimit bitAnd: self bytesPerWord - 1) = 0.
> - memoryLimit := newMemoryLimit!
>
> Item was added:
> + ----- Method: ObjectMemory>>setShrinkThreshold: (in category 'accessing') -----
> + setShrinkThreshold: arg
> + shrinkThreshold := arg!
>
> Item was added:
> + ----- Method: ObjectMemory>>setSignalLowSpace: (in category 'accessing') -----
> + setSignalLowSpace: boolean
> + signalLowSpace := boolean!
>
> Item was added:
> + ----- Method: ObjectMemory>>setSpecialObjectsOop: (in category 'accessing') -----
> + setSpecialObjectsOop: oop
> + "Simulation support"
> + specialObjectsOop := oop!
>
> Item was added:
> + ----- Method: ObjectMemory>>setStatpendingFinalizationSignals: (in category 'accessing') -----
> + setStatpendingFinalizationSignals: arg
> + statpendingFinalizationSignals := arg!
>
> Item was added:
> + ----- Method: ObjectMemory>>setTenuringThreshold: (in category 'accessing') -----
> + setTenuringThreshold: arg
> + tenuringThreshold := arg!
>
> Item was added:
> + ----- Method: ObjectMemory>>setYoungStart: (in category 'accessing') -----
> + setYoungStart: arg
> + youngStart := arg!
>
> Item was removed:
> - ----- Method: ObjectMemory>>shrinkThreshold (in category 'accessing') -----
> - shrinkThreshold
> - ^shrinkThreshold!
>
> Item was removed:
> - ----- Method: ObjectMemory>>shrinkThreshold: (in category 'accessing') -----
> - shrinkThreshold: arg
> - shrinkThreshold := arg!
>
> Item was removed:
> - ----- Method: ObjectMemory>>signalLowSpace (in category 'accessing') -----
> - signalLowSpace
> - ^signalLowSpace!
>
> Item was removed:
> - ----- Method: ObjectMemory>>signalLowSpace: (in category 'accessing') -----
> - signalLowSpace: boolean
> - signalLowSpace := boolean!
>
> Item was removed:
> - ----- Method: ObjectMemory>>specialObjectsOop (in category 'accessing') -----
> - specialObjectsOop
> - "Simulation support"
> - ^specialObjectsOop!
>
> Item was removed:
> - ----- Method: ObjectMemory>>specialObjectsOop: (in category 'accessing') -----
> - specialObjectsOop: oop
> - "Simulation support"
> - specialObjectsOop := oop!
>
> Item was added:
> + ----- Method: ObjectMemory>>startOfFreeSpace (in category 'accessing') -----
> + startOfFreeSpace
> + <returnTypeC: #usqInt>
> + self subclassResponsibility!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statAllocationCount (in category 'accessing') -----
> - statAllocationCount
> - ^statAllocationCount!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statCompMoveCount (in category 'accessing') -----
> - statCompMoveCount
> - ^statCompMoveCount!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statFullGCMSecs (in category 'accessing') -----
> - statFullGCMSecs
> - ^statFullGCMSecs!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statFullGCs (in category 'accessing') -----
> - statFullGCs
> - ^statFullGCs!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statGCTime (in category 'accessing') -----
> - statGCTime
> - ^statGCTime!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statGrowMemory (in category 'accessing') -----
> - statGrowMemory
> - ^statGrowMemory!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statIGCDeltaTime (in category 'accessing') -----
> - statIGCDeltaTime
> - ^statIGCDeltaTime!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statIncrGCMSecs (in category 'accessing') -----
> - statIncrGCMSecs
> - ^statIncrGCMSecs!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statIncrGCs (in category 'accessing') -----
> - statIncrGCs
> - ^statIncrGCs!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statMarkCount (in category 'accessing') -----
> - statMarkCount
> - ^statMarkCount!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statMkFwdCount (in category 'accessing') -----
> - statMkFwdCount
> - ^statMkFwdCount!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statRootTableCount (in category 'accessing') -----
> - statRootTableCount
> - ^statRootTableCount!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statRootTableOverflows (in category 'accessing') -----
> - statRootTableOverflows
> - ^statRootTableOverflows!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statShrinkMemory (in category 'accessing') -----
> - statShrinkMemory
> - ^statShrinkMemory!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statSpecialMarkCount (in category 'accessing') -----
> - statSpecialMarkCount
> - ^statSpecialMarkCount!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statSurvivorCount (in category 'accessing') -----
> - statSurvivorCount
> - ^statSurvivorCount!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statSweepCount (in category 'accessing') -----
> - statSweepCount
> - ^statSweepCount!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statTenures (in category 'accessing') -----
> - statTenures
> - ^statTenures!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statpendingFinalizationSignals (in category 'accessing') -----
> - statpendingFinalizationSignals
> - ^statpendingFinalizationSignals!
>
> Item was removed:
> - ----- Method: ObjectMemory>>statpendingFinalizationSignals: (in category 'accessing') -----
> - statpendingFinalizationSignals: arg
> - statpendingFinalizationSignals := arg!
>
> Item was removed:
> - ----- Method: ObjectMemory>>tenuringThreshold (in category 'accessing') -----
> - tenuringThreshold
> - ^tenuringThreshold!
>
> Item was removed:
> - ----- Method: ObjectMemory>>tenuringThreshold: (in category 'accessing') -----
> - tenuringThreshold: arg
> - tenuringThreshold := arg!
>
> Item was removed:
> - ----- Method: ObjectMemory>>trueObj (in category 'accessing') -----
> - trueObj
> - ^trueObj!
>
> Item was removed:
> - ----- Method: ObjectMemory>>trueObj: (in category 'accessing') -----
> - trueObj: oop
> - trueObj := oop!
>
> Item was removed:
> - ----- Method: ObjectMemory>>weakRoots: (in category 'accessing') -----
> - weakRoots: table
> - "Simulation support"
> - weakRoots := table!
>
> Item was removed:
> - ----- Method: ObjectMemory>>youngStart (in category 'accessing') -----
> - youngStart
> - self subclassResponsibility!
>
> Item was removed:
> - ----- Method: ObjectMemory>>youngStart: (in category 'accessing') -----
> - youngStart: arg
> - youngStart := arg!
>
> Item was changed:
> ----- Method: ObjectMemorySimulator>>allObjectsDo: (in category 'debug support') -----
> allObjectsDo: objBlock
>
> | oop |
> oop := self firstObject.
> + [oop < self getEndOfMemory] whileTrue:
> - [oop < self endOfMemory] whileTrue:
> [(self isFreeObject: oop)
> ifFalse: [objBlock value: oop].
> oop := self objectAfter: oop].
> !
>
> Item was changed:
> ----- Method: ObjectMemorySimulator>>allObjectsSelect: (in category 'debug support') -----
> allObjectsSelect: objBlock
> "self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]"
>
> | oop selected |
> oop := self firstObject.
> selected := OrderedCollection new.
> + [oop < self getEndOfMemory] whileTrue:
> - [oop < self endOfMemory] whileTrue:
> [(self isFreeObject: oop)
> ifFalse: [(objBlock value: oop) ifTrue: [selected addLast: oop]].
> oop := self objectAfter: oop].
> ^ selected!
>
> Item was changed:
> ----- Method: ObjectMemorySimulator>>numObjects (in category 'debug support') -----
> numObjects
>
> | count oop |
> count := 0.
> oop := self firstObject.
> + [oop < self getEndOfMemory] whileTrue:
> - [oop < self endOfMemory] whileTrue:
> [(self isFreeObject: oop)
> ifFalse: [count := count + 1].
> oop := self objectAfter: oop].
> ^count
> !
>
> Item was added:
> + ----- Method: ObjectMemorySimulator>>setHeaderTypeBytes: (in category 'initialization') -----
> + setHeaderTypeBytes: array
> + headerTypeBytes := array!
>
> Item was added:
> + ----- Method: ObjectMemorySimulator>>setInterpreter: (in category 'initialization') -----
> + setInterpreter: anInterpreter
> + interpreter := anInterpreter!
>
> Item was added:
> + ----- Method: ObjectMemorySimulator>>setRemapBuffer: (in category 'initialization') -----
> + setRemapBuffer: table
> + remapBuffer := table!
>
> Item was added:
> + ----- Method: ObjectMemorySimulator>>setRootTable: (in category 'initialization') -----
> + setRootTable: table
> + rootTable := table!
>
> Item was added:
> + ----- Method: ObjectMemorySimulator>>setWeakRoots: (in category 'initialization') -----
> + setWeakRoots: table
> + weakRoots := table!
>
> Item was changed:
> ----- Method: SlangTestSupportInterpreter>>setInstanceVariableWithAnAccessorMethod (in category 'local and instance vars') -----
> setInstanceVariableWithAnAccessorMethod
> + objectMemory setAVariable: (objectMemory remap: objectMemory getNilObj).
> - objectMemory setAVariable: (objectMemory remap: objectMemory nilObj).
> !
>
> Item was changed:
> ----- Method: SlangTestSupportPlugin>>methodWithLoopLimitThatIsNotModified: (in category 'loop limits') -----
> methodWithLoopLimitThatIsNotModified: arrayObj
>
> + 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: 0]
> - 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]
> !
>
> Item was changed:
> ----- Method: SlangTestSupportSSIP>>methodWithLoopLimitThatIsNotModified: (in category 'loop limits') -----
> methodWithLoopLimitThatIsNotModified: arrayObj
>
> + 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: 0]
> - 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]
> !
>
> Item was changed:
> ----- Method: StackInterpreter>>checkForEventsMayContextSwitch: (in category 'process primitive support') -----
> checkForEventsMayContextSwitch: mayContextSwitch
> "Check for possible interrupts and handle one if necessary.
> Answer if a context switch has occurred."
> | switched sema now |
> <inline: false>
> <var: #now type: #usqLong>
> statCheckForEvents := statCheckForEvents + 1.
>
> "restore the stackLimit if it has been smashed."
> self restoreStackLimit.
> self externalWriteBackHeadFramePointers.
> self assert: stackPage = stackPages mostRecentlyUsedPage.
>
> "Allow the platform to do anything it needs to do synchronously."
> self ioSynchronousCheckForEvents.
>
> self checkCogCompiledCodeCompactionCalledFor.
>
> objectMemory needGCFlag ifTrue:
> + [objectMemory setNeedGCFlag: false.
> - [objectMemory needGCFlag: false.
> "sufficientSpaceAfterGC: runs the incremental GC and
> then, if not enough space is available, the fullGC."
> (objectMemory sufficientSpaceAfterGC: 0) ifFalse:
> [self setSignalLowSpaceFlagAndSaveProcess]].
>
> mayContextSwitch ifFalse: [^false].
>
> switched := false.
>
> (profileProcess ~= objectMemory nilObject
> or: [nextProfileTick > 0 and:[self ioHighResClock >= nextProfileTick]]) ifTrue:
> ["Take a sample (if not already done so) for the profiler if it is active. This
> must be done before any of the synchronousSignals below or else we will
> attribute a pause in ioRelinquishProcessor to the newly activated process."
> profileProcess = objectMemory nilObject ifTrue:
> [profileProcess := self activeProcess.
> profileMethod := objectMemory nilObject].
> "and signal the profiler semaphore if it is present"
> (profileSemaphore ~= objectMemory nilObject
> and: [self synchronousSignal: profileSemaphore]) ifTrue:
> [switched := true].
> nextProfileTick := 0].
>
> self checkDeliveryOfLongRunningPrimitiveSignal ifTrue:
> [switched := true].
>
> + objectMemory getSignalLowSpace ifTrue:
> + [objectMemory setSignalLowSpace: false. "reset flag"
> - objectMemory signalLowSpace ifTrue:
> - [objectMemory signalLowSpace: false. "reset flag"
> sema := objectMemory splObj: TheLowSpaceSemaphore.
> (sema ~= objectMemory nilObject
> and: [self synchronousSignal: sema]) ifTrue:
> [switched := true]].
>
> "inIOProcessEvents prevents reentrancy into ioProcessEvents and allows disabling
> ioProcessEvents e.g. for native GUIs. We would like to manage that here but can't
> since the platform code may choose to call ioProcessEvents itself in various places."
> false
> ifTrue:
> [((now := self ioUTCMicroseconds) >= nextPollUsecs
> and: [inIOProcessEvents = 0]) ifTrue:
> [statIOProcessEvents := statIOProcessEvents + 1.
> inIOProcessEvents := inIOProcessEvents + 1.
> self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
> inIOProcessEvents > 0 ifTrue:
> [inIOProcessEvents := inIOProcessEvents - 1].
> nextPollUsecs := now + 20000
> "msecs to wait before next call to ioProcessEvents. Note that strictly
> speaking we might need to update 'now' at this point since
> ioProcessEvents could take a very long time on some platforms"]]
> ifFalse:
> [(now := self ioUTCMicroseconds) >= nextPollUsecs ifTrue:
> [statIOProcessEvents := statIOProcessEvents + 1.
> self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
> nextPollUsecs := now + 20000
> "msecs to wait before next call to ioProcessEvents. Note that strictly
> speaking we might need to update 'now' at this point since
> ioProcessEvents could take a very long time on some platforms"]].
>
> interruptPending ifTrue:
> [interruptPending := false.
> "reset interrupt flag"
> sema := objectMemory splObj: TheInterruptSemaphore.
> (sema ~= objectMemory nilObject
> and: [self synchronousSignal: sema]) ifTrue:
> [switched := true]].
>
> nextWakeupUsecs ~= 0 ifTrue:
> [now >= nextWakeupUsecs ifTrue:
> [nextWakeupUsecs := 0.
> "set timer interrupt to 0 for 'no timer'"
> sema := objectMemory splObj: TheTimerSemaphore.
> (sema ~= objectMemory nilObject
> and: [self synchronousSignal: sema]) ifTrue:
> [switched := true]]].
>
> "signal any pending finalizations"
> pendingFinalizationSignals > 0 ifTrue:
> [sema := objectMemory splObj: TheFinalizationSemaphore.
> ((objectMemory isClassOfNonImm: sema equalTo: (objectMemory splObj: ClassSemaphore))
> and: [self synchronousSignal: sema]) ifTrue:
> [switched := true].
> pendingFinalizationSignals := 0].
>
> "signal all semaphores in semaphoresToSignal"
> self signalExternalSemaphores ifTrue:
> [switched := true].
>
> ^switched!
>
> Item was changed:
> ----- Method: StackInterpreter>>checkInterpreterIntegrity (in category 'object memory support') -----
> checkInterpreterIntegrity
> "Perform an integrity/leak check using the heapMap. Assume
> clearLeakMapAndMapAccessibleObjects has set a bit at each
> object's header. Check that all oops in the interpreter's state
> points to a header. Answer if all checks pass."
> | ok |
> ok := true.
> + (objectMemory checkOopIntegrity: objectMemory getSpecialObjectsOop named: 'specialObjectsOop')ifFalse:
> - (objectMemory checkOopIntegrity: objectMemory specialObjectsOop named: 'specialObjectsOop')ifFalse:
> [ok := false].
> (objectMemory isIntegerObject: messageSelector) ifFalse:
> [(objectMemory checkOopIntegrity: messageSelector named: 'messageSelector')ifFalse:
> [ok := false]].
> (objectMemory checkOopIntegrity: newMethod named: 'newMethod')ifFalse:
> [ok := false].
> (objectMemory checkOopIntegrity: lkupClass named: 'lkupClass')ifFalse:
> [ok := false].
> (objectMemory checkOopIntegrity: profileProcess named: 'profileProcess')ifFalse:
> [ok := false].
> (objectMemory checkOopIntegrity: profileMethod named: 'profileMethod')ifFalse:
> [ok := false].
> (objectMemory checkOopIntegrity: profileSemaphore named: 'profileSemaphore')ifFalse:
> [ok := false].
> tempOop = 0 ifFalse:
> [(objectMemory checkOopIntegrity: tempOop named: 'tempOop')ifFalse:
> [ok := false]].
>
> "Callback support - check suspended callback list"
> 1 to: jmpDepth do:
> [:i|
> (objectMemory checkOopIntegrity: (suspendedCallbacks at: i) named: 'suspendedCallbacks' index: i) ifFalse:
> [ok := false].
> (objectMemory checkOopIntegrity: (suspendedMethods at: i) named: 'suspendedMethods' index: i) ifFalse:
> [ok := false]].
>
> self checkLogIntegrity ifFalse:
> [ok := false].
>
> ^ok!
>
> Item was changed:
> ----- Method: StackInterpreter>>dumpImage: (in category 'image save/restore') -----
> dumpImage: fileName
> "Dump the entire image out to the given file. Intended for debugging only."
> | f dataSize result |
> <export: true>
> <var: #f type: 'sqImageFile'>
>
> f := self cCode: 'sqImageFileOpen(pointerForOop(fileName), "wb")'.
> f = nil ifTrue: [^-1].
> + dataSize := objectMemory getEndOfMemory - objectMemory startOfMemory.
> - dataSize := objectMemory endOfMemory - objectMemory startOfMemory.
> result := self cCode: 'sqImageFileWrite(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
> self cCode: 'sqImageFileClose(f)'.
> ^result
> !
>
> Item was changed:
> ----- Method: StackInterpreter>>ensureImageFormatIsUpToDate: (in category 'image save/restore') -----
> ensureImageFormatIsUpToDate: swapBytes
> "Ensure the image data has been updayed to suit the current VM."
> <inline: false>
> swapBytes
> ifTrue: [self reverseBytesInImage]
> + ifFalse: [self convertFloatsToPlatformOrderFrom: objectMemory firstObject to: objectMemory getEndOfMemory]!
> - ifFalse: [self convertFloatsToPlatformOrderFrom: objectMemory firstObject to: objectMemory endOfMemory]!
>
> Item was changed:
> ----- Method: StackInterpreter>>mapInterpreterOops (in category 'object memory support') -----
> mapInterpreterOops
> "Map all oops in the interpreter's state to their new values
> during garbage collection or a become: operation."
> "Assume: All traced variables contain valid oops."
> | oop |
> objectMemory nilObject: (objectMemory remap: objectMemory nilObject).
> + objectMemory setFalseObject: (objectMemory remap: objectMemory falseObject).
> + objectMemory setTrueObject: (objectMemory remap: objectMemory trueObject).
> + objectMemory setSpecialObjectsOop: (objectMemory remap: objectMemory getSpecialObjectsOop).
> - objectMemory falseObject: (objectMemory remap: objectMemory falseObject).
> - objectMemory trueObject: (objectMemory remap: objectMemory trueObject).
> - objectMemory specialObjectsOop: (objectMemory remap: objectMemory specialObjectsOop).
> self mapStackPages.
> self mapMachineCode.
> self mapTraceLogs.
> self mapVMRegisters.
> self mapProfileState.
> tempOop = 0 ifFalse: [tempOop := self remap: tempOop].
> + 1 to: objectMemory getRemapBufferCount do: [:i |
> + oop := objectMemory remapBufferAt: i.
> - 1 to: objectMemory remapBufferCount do: [:i |
> - oop := objectMemory remapBuffer at: i.
> (objectMemory isIntegerObject: oop)
> + ifFalse: [objectMemory remapBufferAt: i put: (objectMemory remap: oop)]].
> - ifFalse: [objectMemory remapBuffer at: i put: (objectMemory remap: oop)]].
>
> "Callback support - trace suspended callback list"
> 1 to: jmpDepth do:[:i|
> oop := suspendedCallbacks at: i.
> (objectMemory isIntegerObject: oop)
> ifFalse:[suspendedCallbacks at: i put: (objectMemory remap: oop)].
> oop := suspendedMethods at: i.
> (objectMemory isIntegerObject: oop)
> ifFalse:[suspendedMethods at: i put: (objectMemory remap: oop)].
> ].
> !
>
> Item was changed:
> ----- Method: StackInterpreter>>markAndTraceInterpreterOops: (in category 'object memory support') -----
> markAndTraceInterpreterOops: fullGCFlag
> "Mark and trace all oops in the interpreter's state."
> "Assume: All traced variables contain valid oops."
> | oop |
> "Must mark stack pages first to initialize the per-page trace
> flags for full garbage collect before any subsequent tracing."
> self markAndTraceStackPages: fullGCFlag.
> self markAndTraceTraceLog.
> self markAndTracePrimTraceLog.
> + objectMemory markAndTrace: objectMemory getSpecialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
> - objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
> (objectMemory isIntegerObject: messageSelector) ifFalse:
> [objectMemory markAndTrace: messageSelector].
> (objectMemory isIntegerObject: newMethod) ifFalse:
> [objectMemory markAndTrace: newMethod.
> objectMemory markAndTrace: lkupClass].
> self traceProfileState.
> tempOop = 0 ifFalse: [self markAndTrace: tempOop].
>
> + 1 to: objectMemory getRemapBufferCount do: [:i |
> + oop := objectMemory remapBufferAt: i.
> - 1 to: objectMemory remapBufferCount do: [:i |
> - oop := objectMemory remapBuffer at: i.
> (objectMemory isIntegerObject: oop) ifFalse: [objectMemory markAndTrace: oop]].
>
> "Callback support - trace suspended callback list"
> 1 to: jmpDepth do:[:i|
> oop := suspendedCallbacks at: i.
> (objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
> oop := suspendedMethods at: i.
> (objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
> ]!
>
> Item was changed:
> ----- Method: StackInterpreter>>okayInterpreterObjects (in category 'debug support') -----
> okayInterpreterObjects
>
> | oopOrZero oop |
> self okayFields: objectMemory nilObject.
> self okayFields: objectMemory falseObject.
> self okayFields: objectMemory trueObject.
> + self okayFields: objectMemory getSpecialObjectsOop.
> - self okayFields: objectMemory specialObjectsOop.
> self okayFields: messageSelector.
> self okayFields: newMethod.
> self okayFields: lkupClass.
> 0 to: MethodCacheEntries - 1 by: MethodCacheEntrySize do: [ :i |
> oopOrZero := methodCache at: i + MethodCacheSelector.
> oopOrZero = 0 ifFalse: [
> self okayFields: (methodCache at: i + MethodCacheSelector).
> self okayFields: (methodCache at: i + MethodCacheClass).
> self okayFields: (methodCache at: i + MethodCacheMethod).
> ].
> ].
> + 1 to: objectMemory getRemapBufferCount do: [ :i |
> + oop := objectMemory remapBufferAt: i.
> - 1 to: objectMemory remapBufferCount do: [ :i |
> - oop := objectMemory remapBuffer at: i.
> (objectMemory isIntegerObject: oop) ifFalse: [
> self okayFields: oop.
> ].
> ].
> self okayStackZone.!
>
> Item was changed:
> ----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
> readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
> "Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
> "Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
> "This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
>
> | swapBytes headerStart headerSize dataSize oldBaseAddr hdrNumStackPages
> minimumMemory memStart bytesRead bytesToShift heapSize hdrEdenBytes
> headerFlags hdrMaxExtSemTabSize |
> <var: #f type: 'sqImageFile '>
> <var: #memStart type: 'usqInt'>
> <var: #desiredHeapSize type: 'usqInt'>
> <var: #headerStart type: 'squeakFileOffsetType '>
> <var: #dataSize type: 'size_t '>
> <var: #imageOffset type: 'squeakFileOffsetType '>
>
> metaclassSizeBytes := 6 * self bytesPerWord. "guess (Metaclass instSize * BPW)"
> swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
> headerStart := (self sqImageFilePosition: f) - self bytesPerWord. "record header start position"
>
> headerSize := self getLongFromFile: f swap: swapBytes.
> dataSize := self getLongFromFile: f swap: swapBytes.
> oldBaseAddr := self getLongFromFile: f swap: swapBytes.
> + objectMemory setSpecialObjectsOop: (self getLongFromFile: f swap: swapBytes).
> + objectMemory setLastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
> - objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
> - objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
> savedWindowSize := self getLongFromFile: f swap: swapBytes.
> headerFlags := self getLongFromFile: f swap: swapBytes.
> self setImageHeaderFlagsFrom: headerFlags.
> extraVMMemory := self getLongFromFile: f swap: swapBytes.
> hdrNumStackPages := self getShortFromFile: f swap: swapBytes.
> "4 stack pages is small. Should be able to run with as few as
> three. 4 should be comfortable but slow. 8 is a reasonable
> default. Can be changed via vmParameterAt: 43 put: n.
> Can be set as a preference (Info.plist, VM.ini, command line etc).
> If desiredNumStackPages is already non-zero then it has been
> set as a preference. Ignore (but preserve) the header's default."
> numStackPages := desiredNumStackPages ~= 0
> ifTrue: [desiredNumStackPages]
> ifFalse: [hdrNumStackPages = 0
> ifTrue: [self defaultNumStackPages]
> ifFalse: [hdrNumStackPages]].
> desiredNumStackPages := hdrNumStackPages.
> "pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
> Preserve it to be polite to images run on Cog."
> theUnknownShort := self getShortFromFile: f swap: swapBytes.
> hdrEdenBytes := self getLongFromFile: f swap: swapBytes.
> + objectMemory setEdenBytes: (desiredEdenBytes ~= 0
> - objectMemory edenBytes: (desiredEdenBytes ~= 0
> ifTrue: [desiredEdenBytes]
> ifFalse:
> [hdrEdenBytes = 0
> ifTrue: [objectMemory defaultEdenBytes]
> ifFalse: [hdrEdenBytes]]).
> desiredEdenBytes := hdrEdenBytes.
> hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
> hdrMaxExtSemTabSize ~= 0 ifTrue:
> [self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
> "decrease Squeak object heap to leave extra memory for the VM"
> heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
>
> "compare memory requirements with availability".
> minimumMemory := dataSize + objectMemory edenBytes + self interpreterAllocationReserveBytes.
> heapSize < minimumMemory ifTrue:
> [self insufficientMemorySpecifiedError].
>
> "allocate a contiguous block of memory for the Squeak heap"
> + objectMemory setMemory: (self cCode: 'sqAllocateMemory(minimumMemory, heapSize)').
> + objectMemory getMemory = nil ifTrue: [self insufficientMemoryAvailableError].
> - objectMemory memory: (self cCode: 'sqAllocateMemory(minimumMemory, heapSize)').
> - objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
>
> memStart := objectMemory startOfMemory.
> objectMemory setMemoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety"
> objectMemory setEndOfMemory: memStart + dataSize.
>
> "position file after the header"
> self sqImageFile: f Seek: headerStart + headerSize.
>
> "read in the image in bulk, then swap the bytes if necessary"
> bytesRead := self cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
> bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
>
> self ensureImageFormatIsUpToDate: swapBytes.
>
> "compute difference between old and new memory base addresses"
> bytesToShift := memStart - oldBaseAddr.
> self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
> ^dataSize
> !
>
> Item was changed:
> ----- Method: StackInterpreter>>reverseBytesInImage (in category 'image save/restore') -----
> reverseBytesInImage
> "Byte-swap all words in memory after reading in the entire image file with bulk read. Contributed by Tim Rowledge."
>
> "First, byte-swap every word in the image. This fixes objects headers."
> + objectMemory reverseBytesFrom: objectMemory startOfMemory to: objectMemory getEndOfMemory.
> - objectMemory reverseBytesFrom: objectMemory startOfMemory to: objectMemory endOfMemory.
>
> "Second, return the bytes of bytes-type objects to their orginal order, and perform any
> other format conversions."
> + self updateObjectsPostByteSwapFrom: objectMemory firstObject to: objectMemory getEndOfMemory!
> - self updateObjectsPostByteSwapFrom: objectMemory firstObject to: objectMemory endOfMemory!
>
> Item was changed:
> ----- Method: StackInterpreter>>setSignalLowSpaceFlagAndSaveProcess (in category 'process primitive support') -----
> setSignalLowSpaceFlagAndSaveProcess
> "The low space semaphore is about to be signaled. Set the signalLowSpace flag,
> and force an interrupt check. Save the currently active process in the special
> objects array so that the low space handler will be able to determine the process
> that first triggered a low space condition. The image's low space handler is expected
> to nil out the special objects array slot when it handles the low space condition."
>
> | lastSavedProcess activeProc |
> <inline: false>
> DumpStackOnLowSpace ~= 0 ifTrue:
> [self printCallStack.
> self printAllStacks].
> + objectMemory setSignalLowSpace: true.
> + objectMemory setLowSpaceThreshold: 0. "disable additional interrupts until lowSpaceThreshold is reset by image"
> - objectMemory signalLowSpace: true.
> - objectMemory lowSpaceThreshold: 0. "disable additional interrupts until lowSpaceThreshold is reset by image"
> lastSavedProcess := objectMemory splObj: ProcessSignalingLowSpace.
> lastSavedProcess = objectMemory nilObject ifTrue:
> [activeProc := self activeProcess.
> objectMemory splObj: ProcessSignalingLowSpace put: activeProc].
> self forceInterruptCheck!
>
> Item was changed:
> ----- Method: StackInterpreter>>storeAndPopReceiverVariableBytecode (in category 'stack bytecodes') -----
> storeAndPopReceiverVariableBytecode
> "Note: This code uses
> storePointerUnchecked:ofObject:withValue: and does the
> store check explicitely in order to help the translator
> produce better code."
> | rcvr top |
> rcvr := self receiver.
> top := self internalStackTop.
> + (self oop: rcvr isLessThan: objectMemory getYoungStart) ifTrue:
> - (self oop: rcvr isLessThan: objectMemory youngStart) ifTrue:
> [objectMemory possibleRootStoreInto: rcvr value: top].
> objectMemory storePointerUnchecked: (currentBytecode bitAnd: 7) ofObject: rcvr withValue: top.
> self fetchNextBytecode.
> self internalPop: 1!
>
> Item was changed:
> ----- Method: StackInterpreter>>writeImageFileIO: (in category 'image save/restore') -----
> writeImageFileIO: imageBytes
>
> | headerStart headerSize f bytesWritten sCWIfn okToWrite memStart |
> <var: #f type: 'sqImageFile'>
> <var: #headerStart type: 'squeakFileOffsetType '>
> <var: #sCWIfn type: 'void *'>
>
> "If the security plugin can be loaded, use it to check for write permission.
> If not, assume it's ok"
> sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
> sCWIfn ~= 0 ifTrue:
> [okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
> okToWrite ifFalse:[^self primitiveFail]].
>
> "local constants"
> headerStart := 0.
> headerSize := 64. "header size in bytes; do not change!!"
>
> f := self cCode: 'sqImageFileOpen(imageName, "wb")'.
> f = nil ifTrue: "could not open the image file for writing"
> [^self primitiveFail].
>
> headerStart := self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+imageBytes)'.
> self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
> "position file to start of header"
> self sqImageFile: f Seek: headerStart.
>
> self putLong: self imageFormatVersion toFile: f.
> self putLong: headerSize toFile: f.
> self putLong: imageBytes toFile: f.
> self putLong: objectMemory startOfMemory toFile: f.
> + self putLong: objectMemory getSpecialObjectsOop toFile: f.
> - self putLong: objectMemory specialObjectsOop toFile: f.
> self putLong: objectMemory newObjectHash toFile: f.
> self putLong: self ioScreenSize toFile: f.
> self putLong: self getImageHeaderFlags toFile: f.
> self putLong: extraVMMemory toFile: f.
> self putShort: desiredNumStackPages toFile: f.
> self putShort: self unknownShortOrCodeSizeInKs toFile: f.
> self putLong: desiredEdenBytes toFile: f.
> self putShort: (maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]) toFile: f.
> self putShort: 0 toFile: f.
> 1 to: 4 do: [:i | self putLong: 0 toFile: f]. "fill remaining header words with zeros"
> self successful ifFalse: [
> "file write or seek failure"
> self cCode: 'sqImageFileClose(f)'.
> ^ nil].
>
> "position file after the header"
> self sqImageFile: f Seek: headerStart + headerSize.
>
> "write the image data"
> memStart := objectMemory startOfMemory.
> bytesWritten := self cCode: 'sqImageFileWrite(pointerForOop(memStart), sizeof(unsigned char), imageBytes, f)'.
> self success: bytesWritten = imageBytes.
> self touch: memStart.
> self cCode: 'sqImageFileClose(f)'
> !
>
> Item was changed:
> ----- Method: StackInterpreterPrimitives>>primitiveSetGCSemaphore (in category 'memory space primitives') -----
> primitiveSetGCSemaphore
> "Primitive. Indicate the semaphore to be signalled for upon garbage collection"
> | index |
> <export: true>
> index := self stackIntegerValue: 0.
> self successful ifTrue:[
> + objectMemory setGcSemaphoreIndex: index.
> - gcSemaphoreIndex := index.
> self pop: argumentCount.
> ]!
>
> Item was changed:
> ----- Method: StackInterpreterPrimitives>>primitiveSignalAtMilliseconds (in category 'system control primitives') -----
> primitiveSignalAtMilliseconds
> "Cause the time semaphore, if one has been registered, to be
> signalled when the microsecond clock is greater than or equal to
> the given tick value. A tick value of zero turns off timer interrupts."
> | msecsObj msecs deltaMsecs sema |
> <var: #msecs type: #usqInt>
> msecsObj := self stackTop.
> sema := self stackValue: 1.
> msecs := self positive32BitValueOf: msecsObj.
> (self failed
> or: [objectMemory isIntegerObject: sema]) ifTrue:
> [self primitiveFail.
> ^nil].
> (objectMemory fetchClassOfNonInt: sema) = (objectMemory splObj: ClassSemaphore)
> ifTrue:
> [objectMemory splObj: TheTimerSemaphore put: sema.
> deltaMsecs := msecs - (self ioMSecs bitAnd: MillisecondClockMask).
> deltaMsecs < 0 ifTrue:
> [deltaMsecs := deltaMsecs + MillisecondClockMask + 1].
> nextWakeupUsecs := self ioUTCMicroseconds + (deltaMsecs * 1000)]
> ifFalse:
> [objectMemory
> storePointer: TheTimerSemaphore
> + ofObject: objectMemory getSpecialObjectsOop
> - ofObject: objectMemory specialObjectsOop
> withValue: objectMemory nilObject.
> nextWakeupUsecs := 0].
> self pop: 2!
>
> Item was changed:
> ----- Method: StackInterpreterPrimitives>>primitiveSignalAtUTCMicroseconds (in category 'system control primitives') -----
> primitiveSignalAtUTCMicroseconds
> "Cause the time semaphore, if one has been registered, to be
> signalled when the microsecond clock is greater than or equal to
> the given tick value. A tick value of zero turns off timer interrupts."
> | usecsObj sema usecs |
> <var: #usecs type: #usqLong>
> usecsObj := self stackTop.
> sema := self stackValue: 1.
> usecs := self positive64BitValueOf: usecsObj.
> (self failed
> or: [objectMemory isIntegerObject: sema]) ifTrue:
> [self primitiveFail.
> ^nil].
> (objectMemory fetchClassOfNonInt: sema) = (objectMemory splObj: ClassSemaphore)
> ifTrue:
> [objectMemory splObj: TheTimerSemaphore put: sema.
> nextWakeupUsecs := usecs]
> ifFalse:
> [objectMemory
> storePointer: TheTimerSemaphore
> + ofObject: objectMemory getSpecialObjectsOop
> - ofObject: objectMemory specialObjectsOop
> withValue: objectMemory nilObject.
> nextWakeupUsecs := 0].
> self pop: 2!
>
> Item was changed:
> ----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
> (excessive size, no diff calculated)
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>allObjectsDo: (in category 'debug support') -----
> allObjectsDo: objBlock
>
> | oop |
> oop := objectMemory firstObject.
> + [oop < objectMemory getEndOfMemory] whileTrue:
> - [oop < objectMemory endOfMemory] whileTrue:
> [(objectMemory isFreeObject: oop)
> ifFalse: [objBlock value: oop].
> oop := objectMemory objectAfter: oop].
> !
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>allObjectsSelect: (in category 'debug support') -----
> allObjectsSelect: objBlock
> "self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]"
>
> | oop selected |
> oop := objectMemory firstObject.
> selected := OrderedCollection new.
> + [oop < objectMemory getEndOfMemory] whileTrue:
> - [oop < objectMemory endOfMemory] whileTrue:
> [(objectMemory isFreeObject: oop)
> ifFalse: [(objBlock value: oop) ifTrue: [selected addLast: oop]].
> oop := objectMemory objectAfter: oop].
> ^ selected!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>convertToArray (in category 'initialization') -----
> convertToArray
> "I dont believe it -- this *just works*"
>
> + objectMemory setMemory: (objectMemory getMemory as: Array)!
> - objectMemory memory: (objectMemory memory as: Array)!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
> initialize
> "Initialize the StackInterpreterSimulator when running the interpreter
> inside Smalltalk. The primary responsibility of this method is to allocate
> Smalltalk Arrays for variables that will be declared as statically-allocated
> global arrays in the translated code."
>
> | objectMemoryClass |
>
> "initialize class variables"
> objectMemory ifNotNil:
> [^self halt].
>
> objectMemoryClass := self class objectMemoryClass.
>
> objectMemoryClass initBytesPerWord: objectMemoryClass bytesPerWord.
> objectMemoryClass initialize.
> StackInterpreter initialize.
>
> super initialize.
> objectMemory := objectMemoryClass simulatorClass new.
> objectMemory coInterpreter: self.
>
> "Note: we must initialize ConstMinusOne differently for simulation,
> due to the fact that the simulator works only with +ve 32-bit values"
> ConstMinusOne := objectMemory integerObjectOf: -1.
>
> methodCache := Array new: MethodCacheSize.
> atCache := Array new: AtCacheTotalSize.
> self flushMethodCache.
> self flushAtCache.
> + objectMemory setGcSemaphoreIndex: 0.
> - gcSemaphoreIndex := 0.
> externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
> externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
> externalPrimitiveTableFirstFreeIndex := 0.
> primitiveTable := self class primitiveTable copy.
> pluginList := #().
> mappedPluginEntries := #().
> desiredNumStackPages := desiredEdenBytes := 0.
> startMicroseconds := Time totalSeconds * 1000000.
>
> "initialize InterpreterSimulator variables used for debugging"
> byteCount := 0.
> sendCount := 0.
> quitBlock := [^ self].
> traceOn := true.
> printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
> myBitBlt := BitBltSimulator new setInterpreter: self.
> transcript := Transcript.
> displayForm := 'Display has not yet been installed' asDisplayText form.
> suppressHeartbeatFlag := false.
> extSemTabSize := 256.
> disableBooleanCheat := false!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>integerAt: (in category 'memory access') -----
> integerAt: byteAddress
> "Note: Adjusted for Smalltalk's 1-based array indexing."
>
> + ^objectMemory getMemory integerAt: (byteAddress // 4) + 1!
> - ^objectMemory memory integerAt: (byteAddress // 4) + 1!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>integerAt:put: (in category 'memory access') -----
> integerAt: byteAddress put: a32BitValue
> "Note: Adjusted for Smalltalk's 1-based array indexing."
>
> + ^objectMemory getMemory integerAt: (byteAddress // 4) + 1 put: a32BitValue!
> - ^objectMemory memory integerAt: (byteAddress // 4) + 1 put: a32BitValue!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>objectBefore: (in category 'testing') -----
> objectBefore: addr
> | oop prev |
> oop := objectMemory firstObject.
> + [oop < objectMemory getEndOfMemory] whileTrue:
> - [oop < objectMemory endOfMemory] whileTrue:
> [prev := oop. "look here if debugging prev obj overlapping this one"
> oop := objectMemory objectAfter: oop.
> oop >= addr ifTrue: [^ prev]].
> ^0!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>openOn:extraMemory: (in category 'initialization') -----
> openOn: fileName extraMemory: extraBytes
> "InterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
>
> | f version headerSize count oldBaseAddr bytesToShift swapBytes
> hdrNumStackPages hdrEdenBytes headerFlags |
> "open image file and read the header"
>
> ["begin ensure block..."
> f := FileStream readOnlyFileNamed: fileName.
> imageName := f fullName.
> f binary.
> version := self nextLongFrom: f. "current version: 16r1968 (=6504) vive la revolucion!!"
> (self readableFormat: version)
> ifTrue: [swapBytes := false]
> ifFalse: [(version := objectMemory byteSwapped: version) = self imageFormatVersion
> ifTrue: [swapBytes := true]
> ifFalse: [self error: 'incomaptible image format']].
> headerSize := self nextLongFrom: f swap: swapBytes.
> objectMemory setEndOfMemory: (self nextLongFrom: f swap: swapBytes). "first unused location in heap"
> oldBaseAddr := self nextLongFrom: f swap: swapBytes. "object memory base address of image"
> + objectMemory setSpecialObjectsOop: (self nextLongFrom: f swap: swapBytes).
> + objectMemory setLastHash: (self nextLongFrom: f swap: swapBytes). "Should be loaded from, and saved to the image header"
> - objectMemory specialObjectsOop: (self nextLongFrom: f swap: swapBytes).
> - objectMemory lastHash: (self nextLongFrom: f swap: swapBytes). "Should be loaded from, and saved to the image header"
>
> savedWindowSize := self nextLongFrom: f swap: swapBytes.
> headerFlags := self nextLongFrom: f swap: swapBytes.
> self setImageHeaderFlagsFrom: headerFlags.
> extraVMMemory := self nextLongFrom: f swap: swapBytes.
> hdrNumStackPages := self nextShortFrom: f swap: swapBytes.
> "4 stack pages is small. Should be able to run with as few as
> three. 4 should be comfortable but slow. 8 is a reasonable
> default. Can be changed via vmParameterAt: 43 put: n"
> numStackPages := desiredNumStackPages ~= 0
> ifTrue: [desiredNumStackPages]
> ifFalse: [hdrNumStackPages = 0
> ifTrue: [self defaultNumStackPages]
> ifFalse: [hdrNumStackPages]].
> desiredNumStackPages := hdrNumStackPages.
> stackPages := self stackPagesClass new. "Temporary for computeStackZoneSize"
> "pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
> Preserve it to be polite to images run on Cog."
> theUnknownShort := self getShortFromFile: f swap: swapBytes.
> hdrEdenBytes := self nextLongFrom: f swap: swapBytes.
> + objectMemory setEdenBytes: (hdrEdenBytes = 0
> - objectMemory edenBytes: (hdrEdenBytes = 0
> ifTrue: [objectMemory defaultEdenBytes]
> ifFalse: [hdrEdenBytes]).
> desiredEdenBytes := hdrEdenBytes.
> "allocate interpreter memory"
> + objectMemory setMemoryLimit: objectMemory getEndOfMemory + extraBytes + objectMemory edenBytes + self interpreterAllocationReserveBytes.
> - objectMemory setMemoryLimit: objectMemory endOfMemory + extraBytes + objectMemory edenBytes + self interpreterAllocationReserveBytes.
>
> "read in the image in bulk, then swap the bytes if necessary"
> f position: headerSize.
> + objectMemory setMemory: (Bitmap new: objectMemory getMemoryLimit // 4).
> + count := f readInto: objectMemory getMemory startingAt: 1 count: objectMemory getEndOfMemory // 4.
> + count ~= (objectMemory getEndOfMemory // 4) ifTrue: [self halt].
> - objectMemory memory: (Bitmap new: objectMemory memoryLimit // 4).
> - count := f readInto: objectMemory memory startingAt: 1 count: objectMemory endOfMemory // 4.
> - count ~= (objectMemory endOfMemory // 4) ifTrue: [self halt].
> ]
> ensure: [f close].
>
> self ensureImageFormatIsUpToDate: swapBytes.
>
> objectMemory initialize.
> bytesToShift := objectMemory startOfMemory - oldBaseAddr. "adjust pointers for zero base address"
> Utilities informUser: 'Relocating object pointers...'
> during: [self initializeInterpreter: bytesToShift].
> !
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
> reverseBytesFrom: begin to: end
> "Byte-swap the given range of memory (not inclusive!!)."
> | wordAddr |
> wordAddr := begin.
> + objectMemory getMemory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
> - objectMemory memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>showDisplayBits:w:h:d:left:right:top:bottom: (in category 'I/O primitives') -----
> showDisplayBits: destBits w: w h: h d: d left: left right: right top: top bottom: bottom
> | raster pixPerWord simDisp realDisp rect |
> pixPerWord := 32 // d.
> raster := displayForm width + (pixPerWord - 1) // pixPerWord.
> + simDisp := Form new hackBits: objectMemory getMemory.
> - simDisp := Form new hackBits: objectMemory memory.
> displayForm unhibernate.
> realDisp := Form new hackBits: displayForm bits.
> realDisp
> copy: (0 @ (top * raster) extent: 4 @ (bottom - top * raster))
> from: 0 @ (destBits // 4 + (top * raster))
> in: simDisp
> rule: Form over.
> displayView ifNotNil: [^ displayView changed].
>
> "If running without a view, just blat the bits onto the screen..."
> rect := 0 @ top corner: displayForm width @ bottom.
> Display
> copy: (rect translateBy: self displayLocation)
> from: rect topLeft
> in: displayForm
> rule: Form over!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>sqGrowMemory:By: (in category 'memory access') -----
> sqGrowMemory: oldLimit By: delta
>
> transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr.
> + objectMemory setMemory: objectMemory getMemory , (objectMemory getMemory class new: delta // 4).
> + ^ objectMemory getMemory size * 4!
> - objectMemory memory: objectMemory memory , (objectMemory memory class new: delta // 4).
> - ^ objectMemory memory size * 4!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>validOop: (in category 'testing') -----
> validOop: oop
> " Return true if oop appears to be valid "
> (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
> (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
> + oop >= objectMemory getEndOfMemory ifTrue: [^ false]. "Out of range"
> - oop >= objectMemory endOfMemory ifTrue: [^ false]. "Out of range"
> "could test if within the first large freeblock"
> (self longAt: oop) = 4 ifTrue: [^ false].
> (objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object"
> ^ true!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>writeEnableMemory (in category 'debug printing') -----
> writeEnableMemory
> + objectMemory setMemory: objectMemory getMemory array!
> - objectMemory memory: objectMemory memory array!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>writeImageFileIO: (in category 'image save/restore') -----
> writeImageFileIO: numberOfBytesToWrite
> "Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
>
> | headerSize file |
> BytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
> headerSize := 64.
>
> [
> file := (FileStream fileNamed: imageName) binary.
> file == nil ifTrue: [^nil].
>
> {
> self imageFormatVersion.
> headerSize.
> numberOfBytesToWrite.
> objectMemory startOfMemory.
> + (objectMemory getSpecialObjectsOop).
> + (objectMemory getLastHash).
> - (objectMemory specialObjectsOop).
> - (objectMemory lastHash).
> self ioScreenSize.
> fullScreenFlag.
> extraVMMemory
> }
> do: [:long | self putLong: long toFile: file].
>
> { desiredNumStackPages. self unknownShortOrCodeSizeInKs } do:
> [:short| self putShort: short toFile: file].
>
> self putLong: desiredEdenBytes toFile: file.
>
> { maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]. 0 } do:
> [:short| self putShort: short toFile: file].
>
> "Pad the rest of the header."
> 4 timesRepeat: [self putLong: 0 toFile: file].
>
> "Position the file after the header."
> file position: headerSize.
>
> "Write the object memory."
> objectMemory startOfMemory // 4 + 1
> to: numberOfBytesToWrite // 4
> do: [:index |
> self
> + putLong: (objectMemory getMemory at: index)
> - putLong: (objectMemory memory at: index)
> toFile: file].
>
> self success: true
> ]
> ensure: [file close]!
>
> Item was changed:
> ----- Method: StackInterpreterSimulator>>writeProtectMemory (in category 'debug printing') -----
> writeProtectMemory
> + objectMemory setMemory: (ReadOnlyArrayWrapper around: objectMemory getMemory)!
> - objectMemory memory: (ReadOnlyArrayWrapper around: objectMemory memory)!
>
> Item was changed:
> ----- Method: VMMaker class>>versionString (in category 'version testing') -----
> versionString
>
> "VMMaker versionString"
>
> + ^'4.13.3'!
> - ^'4.13.2'!
>
2
2
24 Feb '14
Hi All.
I noticed that VMMakerTool burps on the oscogvm/platforms file path (on linux) while the scripting approach uses that just fine. (Moving all the subdirectories under osgocvm/ to ./ let's the tool do its thing just fine).
My hunch is that scripting is the preferred way to build and VMMakerTool is not used for .oscog
True?
I just want to be sure for documentation purposes.
thx.
tty
2
2
23 Feb '14
Revision: 2870
Author: lewis
Date: 2014-02-23 07:51:51 -0800 (Sun, 23 Feb 2014)
Log Message:
-----------
Sources per VMMaker-dtl.342 (VMMaker 4.13.3)
Fix BalloonEnginePlugin>>stepToNextBezierForward:at: by removing unneeded
cCoerce (this was an earlier workaround for a slang generation bug, no
longer relevant).
Make it possible to produce a working VM with inlining disabled.
Modified Paths:
--------------
trunk/src/ckformat.c
trunk/src/plugins/ADPCMCodecPlugin/ADPCMCodecPlugin.c
trunk/src/plugins/AioPlugin/AioPlugin.c
trunk/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c
trunk/src/plugins/B2DPlugin/B2DPlugin.c
trunk/src/plugins/B3DAcceleratorPlugin/B3DAcceleratorPlugin.c
trunk/src/plugins/BMPReadWriterPlugin/BMPReadWriterPlugin.c
trunk/src/plugins/BitBltPlugin/BitBltPlugin.c
trunk/src/plugins/CameraPlugin/CameraPlugin.c
trunk/src/plugins/ClipboardExtendedPlugin/ClipboardExtendedPlugin.c
trunk/src/plugins/CroquetPlugin/CroquetPlugin.c
trunk/src/plugins/DBusPlugin/DBusPlugin.c
trunk/src/plugins/DSAPrims/DSAPrims.c
trunk/src/plugins/DropPlugin/DropPlugin.c
trunk/src/plugins/FFTPlugin/FFTPlugin.c
trunk/src/plugins/FT2Plugin/FT2Plugin.c
trunk/src/plugins/FileCopyPlugin/FileCopyPlugin.c
trunk/src/plugins/FilePlugin/FilePlugin.c
trunk/src/plugins/FloatArrayPlugin/FloatArrayPlugin.c
trunk/src/plugins/FloatMathPlugin/FloatMathPlugin.c
trunk/src/plugins/GeniePlugin/GeniePlugin.c
trunk/src/plugins/HostWindowPlugin/HostWindowPlugin.c
trunk/src/plugins/JPEGReadWriter2Plugin/JPEGReadWriter2Plugin.c
trunk/src/plugins/JPEGReaderPlugin/JPEGReaderPlugin.c
trunk/src/plugins/JoystickTabletPlugin/JoystickTabletPlugin.c
trunk/src/plugins/Klatt/Klatt.c
trunk/src/plugins/LargeIntegers/LargeIntegers.c
trunk/src/plugins/LocalePlugin/LocalePlugin.c
trunk/src/plugins/MIDIPlugin/MIDIPlugin.c
trunk/src/plugins/Matrix2x3Plugin/Matrix2x3Plugin.c
trunk/src/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c
trunk/src/plugins/Mpeg3Plugin/Mpeg3Plugin.c
trunk/src/plugins/RePlugin/RePlugin.c
trunk/src/plugins/RomePlugin/RomePlugin.c
trunk/src/plugins/ScratchPlugin/ScratchPlugin.c
trunk/src/plugins/SecurityPlugin/SecurityPlugin.c
trunk/src/plugins/SerialPlugin/SerialPlugin.c
trunk/src/plugins/SocketPlugin/SocketPlugin.c
trunk/src/plugins/SoundCodecPrims/SoundCodecPrims.c
trunk/src/plugins/SoundGenerationPlugin/SoundGenerationPlugin.c
trunk/src/plugins/SoundPlugin/SoundPlugin.c
trunk/src/plugins/Squeak3D/Squeak3D.c
trunk/src/plugins/SqueakFFIPrims/SqueakFFIPrims.c
trunk/src/plugins/SqueakSSL/SqueakSSL.c
trunk/src/plugins/StarSqueakPlugin/StarSqueakPlugin.c
trunk/src/plugins/UUIDPlugin/UUIDPlugin.c
trunk/src/plugins/UnicodePlugin/UnicodePlugin.c
trunk/src/plugins/UnixOSProcessPlugin/UnixOSProcessPlugin.c
trunk/src/plugins/WeDoPlugin/WeDoPlugin.c
trunk/src/plugins/XDisplayControlPlugin/XDisplayControlPlugin.c
trunk/src/plugins/ZipPlugin/ZipPlugin.c
trunk/src/vm/interp.c
trunk/src/vm/interp.h
trunk/src/vm/sqNamedPrims.h
Modified: trunk/src/ckformat.c
===================================================================
--- trunk/src/ckformat.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/ckformat.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -5,7 +5,7 @@
/* Usage: ckformat imageFileName */
/* --- DO NOT EDIT THIS FILE --- */
-/* --- Automatically generated from class ImageFormat 2014-02-12T19:19:51.519+01:00--- */
+/* --- Automatically generated from class ImageFormat 2014-02-23T10:39:25.64+01:00--- */
/* --- Source code is in package ImageFormat in the VMMaker repository --- */
/* --- DO NOT EDIT THIS FILE --- */
Modified: trunk/src/plugins/ADPCMCodecPlugin/ADPCMCodecPlugin.c
===================================================================
--- trunk/src/plugins/ADPCMCodecPlugin/ADPCMCodecPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/ADPCMCodecPlugin/ADPCMCodecPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:40 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- ADPCMCodecPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ ADPCMCodecPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "ADPCMCodecPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "ADPCMCodecPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -70,9 +70,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "ADPCMCodecPlugin 12 February 2014 (i)"
+ "ADPCMCodecPlugin 23 February 2014 (i)"
#else
- "ADPCMCodecPlugin 12 February 2014 (e)"
+ "ADPCMCodecPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/AioPlugin/AioPlugin.c
===================================================================
--- trunk/src/plugins/AioPlugin/AioPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/AioPlugin/AioPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,6 +1,6 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:51 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:24 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
UnixAioPlugin VMConstruction-Plugins-AioPlugin-eem.15 uuid: 0029df1c-3720-4b61-8579-4851417d24a7
*/
@@ -88,9 +88,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "AioPlugin 12 February 2014 (i)"
+ "AioPlugin 23 February 2014 (i)"
#else
- "AioPlugin 12 February 2014 (e)"
+ "AioPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c
===================================================================
--- trunk/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:40 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- AsynchFilePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ AsynchFilePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "AsynchFilePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "AsynchFilePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -67,9 +67,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "AsynchFilePlugin 12 February 2014 (i)"
+ "AsynchFilePlugin 23 February 2014 (i)"
#else
- "AsynchFilePlugin 12 February 2014 (e)"
+ "AsynchFilePlugin 23 February 2014 (e)"
#endif
;
static void * sCOAFfn;
Modified: trunk/src/plugins/B2DPlugin/B2DPlugin.c
===================================================================
--- trunk/src/plugins/B2DPlugin/B2DPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/B2DPlugin/B2DPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:41 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:04 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- BalloonEnginePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ BalloonEnginePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "BalloonEnginePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "BalloonEnginePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -447,9 +447,9 @@
static void * loadBBFn;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "B2DPlugin 12 February 2014 (i)"
+ "B2DPlugin 23 February 2014 (i)"
#else
- "B2DPlugin 12 February 2014 (e)"
+ "B2DPlugin 23 February 2014 (e)"
#endif
;
static int* objBuffer;
@@ -6699,21 +6699,21 @@
if (!(((startY = objBuffer[bezier + GEYValue])) == yValue)) {
/* begin stepToNextBezierIn:at: */
/* begin stepToNextBezierForward:at: */
- lastX = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateX];
- lastY = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateY];
- fwDx1 = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDX];
- fwDy1 = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDY];
+ lastX = ((objBuffer + bezier) + GBUpdateData)[GBUpdateX];
+ lastY = ((objBuffer + bezier) + GBUpdateData)[GBUpdateY];
+ fwDx1 = ((objBuffer + bezier) + GBUpdateData)[GBUpdateDX];
+ fwDy1 = ((objBuffer + bezier) + GBUpdateData)[GBUpdateDY];
minY = yValue * 256;
while ((minY > lastY) && (fwDy1 >= 0)) {
lastX += ((sqInt) (fwDx1 + 32768) >> 16);
lastY += ((sqInt) (fwDy1 + 32768) >> 16);
- fwDx1 += (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDDX];
- fwDy1 += (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDDY];
+ fwDx1 += ((objBuffer + bezier) + GBUpdateData)[GBUpdateDDX];
+ fwDy1 += ((objBuffer + bezier) + GBUpdateData)[GBUpdateDDY];
}
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateX] = lastX;
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateY] = lastY;
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDX] = fwDx1;
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDY] = fwDy1;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateX] = lastX;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateY] = lastY;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateDX] = fwDx1;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateDY] = fwDy1;
xValue = ((sqInt) lastX >> 8);
objBuffer[bezier + GEXValue] = xValue;
objBuffer[bezier + GENumLines] = (deltaY - (yValue - startY));
@@ -6987,21 +6987,21 @@
sqInt minY;
/* begin stepToNextBezierForward:at: */
- lastX = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateX];
- lastY = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateY];
- fwDx = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDX];
- fwDy = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDY];
+ lastX = ((objBuffer + bezier) + GBUpdateData)[GBUpdateX];
+ lastY = ((objBuffer + bezier) + GBUpdateData)[GBUpdateY];
+ fwDx = ((objBuffer + bezier) + GBUpdateData)[GBUpdateDX];
+ fwDy = ((objBuffer + bezier) + GBUpdateData)[GBUpdateDY];
minY = yValue * 256;
while ((minY > lastY) && (fwDy >= 0)) {
lastX += ((sqInt) (fwDx + 32768) >> 16);
lastY += ((sqInt) (fwDy + 32768) >> 16);
- fwDx += (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDDX];
- fwDy += (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDDY];
+ fwDx += ((objBuffer + bezier) + GBUpdateData)[GBUpdateDDX];
+ fwDy += ((objBuffer + bezier) + GBUpdateData)[GBUpdateDDY];
}
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateX] = lastX;
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateY] = lastY;
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDX] = fwDx;
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDY] = fwDy;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateX] = lastX;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateY] = lastY;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateDX] = fwDx;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateDY] = fwDy;
xValue = ((sqInt) lastX >> 8);
objBuffer[bezier + GEXValue] = xValue;
}
@@ -7066,21 +7066,21 @@
}
if ((yExit + lineOffset) < 0) {
/* begin stepToNextBezierForward:at: */
- lastX = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateX];
- lastY = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateY];
- fwDx = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDX];
- fwDy = (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDY];
+ lastX = ((objBuffer + bezier) + GBUpdateData)[GBUpdateX];
+ lastY = ((objBuffer + bezier) + GBUpdateData)[GBUpdateY];
+ fwDx = ((objBuffer + bezier) + GBUpdateData)[GBUpdateDX];
+ fwDy = ((objBuffer + bezier) + GBUpdateData)[GBUpdateDY];
minY = yValue * 256;
while ((minY > lastY) && (fwDy >= 0)) {
lastX += ((sqInt) (fwDx + 32768) >> 16);
lastY += ((sqInt) (fwDy + 32768) >> 16);
- fwDx += (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDDX];
- fwDy += (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDDY];
+ fwDx += ((objBuffer + bezier) + GBUpdateData)[GBUpdateDDX];
+ fwDy += ((objBuffer + bezier) + GBUpdateData)[GBUpdateDDY];
}
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateX] = lastX;
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateY] = lastY;
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDX] = fwDx;
- (((int*) ((objBuffer + bezier) + GBUpdateData)))[GBUpdateDY] = fwDy;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateX] = lastX;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateY] = lastY;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateDX] = fwDx;
+ ((objBuffer + bezier) + GBUpdateData)[GBUpdateDY] = fwDy;
((sqInt) lastX >> 8);
} else {
@@ -7089,21 +7089,21 @@
((objBuffer + bezier) + GBUpdateData)[GBUpdateX] = ((objBuffer[bezier + GBFinalX]) * 256);
}
/* begin stepToNextBezierForward:at: */
- lastX1 = (((int*) ((objBuffer + bezier) + GBWideUpdateData)))[GBUpdateX];
- lastY1 = (((int*) ((objBuffer + bezier) + GBWideUpdateData)))[GBUpdateY];
- fwDx1 = (((int*) ((objBuffer + bezier) + GBWideUpdateData)))[GBUpdateDX];
- fwDy1 = (((int*) ((objBuffer + bezier) + GBWideUpdateData)))[GBUpdateDY];
+ lastX1 = ((objBuffer + bezier) + GBWideUpdateData)[GBUpdateX];
+ lastY1 = ((objBuffer + bezier) + GBWideUpdateData)[GBUpdateY];
+ fwDx1 = ((objBuffer + bezier) + GBWideUpdateData)[GBUpdateDX];
+ fwDy1 = ((objBuffer + bezier) + GBWideUpdateData)[GBUpdateDY];
minY1 = yValue * 256;
while ((minY1 > lastY1) && (fwDy1 >= 0)) {
lastX1 += ((sqInt) (fwDx1 + 32768) >> 16);
lastY1 += ((sqInt) (fwDy1 + 32768) >> 16);
- fwDx1 += (((int*) ((objBuffer + bezier) + GBWideUpdateData)))[GBUpdateDDX];
- fwDy1 += (((int*) ((objBuffer + bezier) + GBWideUpdateData)))[GBUpdateDDY];
+ fwDx1 += ((objBuffer + bezier) + GBWideUpdateData)[GBUpdateDDX];
+ fwDy1 += ((objBuffer + bezier) + GBWideUpdateData)[GBUpdateDDY];
}
- (((int*) ((objBuffer + bezier) + GBWideUpdateData)))[GBUpdateX] = lastX1;
- (((int*) ((objBuffer + bezier) + GBWideUpdateData)))[GBUpdateY] = lastY1;
- (((int*) ((objBuffer + bezier) + GBWideUpdateData)))[GBUpdateDX] = fwDx1;
- (((int*) ((objBuffer + bezier) + GBWideUpdateData)))[GBUpdateDY] = fwDy1;
+ ((objBuffer + bezier) + GBWideUpdateData)[GBUpdateX] = lastX1;
+ ((objBuffer + bezier) + GBWideUpdateData)[GBUpdateY] = lastY1;
+ ((objBuffer + bezier) + GBWideUpdateData)[GBUpdateDX] = fwDx1;
+ ((objBuffer + bezier) + GBWideUpdateData)[GBUpdateDY] = fwDy1;
((sqInt) lastX1 >> 8);
computeFinalWideBezierValueswidth(bezier, lineWidth);
}
Modified: trunk/src/plugins/B3DAcceleratorPlugin/B3DAcceleratorPlugin.c
===================================================================
--- trunk/src/plugins/B3DAcceleratorPlugin/B3DAcceleratorPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/B3DAcceleratorPlugin/B3DAcceleratorPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:46 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:13 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- B3DAcceleratorPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ B3DAcceleratorPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "B3DAcceleratorPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "B3DAcceleratorPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -107,9 +107,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "B3DAcceleratorPlugin 12 February 2014 (i)"
+ "B3DAcceleratorPlugin 23 February 2014 (i)"
#else
- "B3DAcceleratorPlugin 12 February 2014 (e)"
+ "B3DAcceleratorPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/BMPReadWriterPlugin/BMPReadWriterPlugin.c
===================================================================
--- trunk/src/plugins/BMPReadWriterPlugin/BMPReadWriterPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/BMPReadWriterPlugin/BMPReadWriterPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:40 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- BMPReadWriterPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ BMPReadWriterPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "BMPReadWriterPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "BMPReadWriterPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -58,9 +58,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "BMPReadWriterPlugin 12 February 2014 (i)"
+ "BMPReadWriterPlugin 23 February 2014 (i)"
#else
- "BMPReadWriterPlugin 12 February 2014 (e)"
+ "BMPReadWriterPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/BitBltPlugin/BitBltPlugin.c
===================================================================
--- trunk/src/plugins/BitBltPlugin/BitBltPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/BitBltPlugin/BitBltPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:42 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:06 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- BitBltSimulation * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ BitBltSimulation VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "BitBltSimulation * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "BitBltSimulation VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -256,9 +256,9 @@
};
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "BitBltPlugin 12 February 2014 (i)"
+ "BitBltPlugin 23 February 2014 (i)"
#else
- "BitBltPlugin 12 February 2014 (e)"
+ "BitBltPlugin 23 February 2014 (e)"
#endif
;
static sqInt nWords;
Modified: trunk/src/plugins/CameraPlugin/CameraPlugin.c
===================================================================
--- trunk/src/plugins/CameraPlugin/CameraPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/CameraPlugin/CameraPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:46 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:14 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- CameraPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ CameraPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "CameraPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "CameraPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -64,9 +64,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "CameraPlugin 12 February 2014 (i)"
+ "CameraPlugin 23 February 2014 (i)"
#else
- "CameraPlugin 12 February 2014 (e)"
+ "CameraPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/ClipboardExtendedPlugin/ClipboardExtendedPlugin.c
===================================================================
--- trunk/src/plugins/ClipboardExtendedPlugin/ClipboardExtendedPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/ClipboardExtendedPlugin/ClipboardExtendedPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:46 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:14 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- ClipboardExtendedPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ ClipboardExtendedPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "ClipboardExtendedPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "ClipboardExtendedPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -61,9 +61,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "ClipboardExtendedPlugin 12 February 2014 (i)"
+ "ClipboardExtendedPlugin 23 February 2014 (i)"
#else
- "ClipboardExtendedPlugin 12 February 2014 (e)"
+ "ClipboardExtendedPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/CroquetPlugin/CroquetPlugin.c
===================================================================
--- trunk/src/plugins/CroquetPlugin/CroquetPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/CroquetPlugin/CroquetPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:43 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:06 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- CroquetPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ CroquetPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "CroquetPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "CroquetPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -73,9 +73,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "CroquetPlugin 12 February 2014 (i)"
+ "CroquetPlugin 23 February 2014 (i)"
#else
- "CroquetPlugin 12 February 2014 (e)"
+ "CroquetPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/DBusPlugin/DBusPlugin.c
===================================================================
--- trunk/src/plugins/DBusPlugin/DBusPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/DBusPlugin/DBusPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,6 +1,6 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:46 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:15 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
DBusPlugin DBus-Plugin-dtl.35 uuid: 2ae30f08-4793-4acb-876b-c443a5f5e665
*/
@@ -143,9 +143,9 @@
static DBusMessageIter messageIter[DBUS_MAXIMUM_TYPE_RECURSION_DEPTH];
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "DBusPlugin 12 February 2014 (i)"
+ "DBusPlugin 23 February 2014 (i)"
#else
- "DBusPlugin 12 February 2014 (e)"
+ "DBusPlugin 23 February 2014 (e)"
#endif
;
static DBusMessage* writeMessage;
Modified: trunk/src/plugins/DSAPrims/DSAPrims.c
===================================================================
--- trunk/src/plugins/DSAPrims/DSAPrims.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/DSAPrims/DSAPrims.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:43 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:07 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- DSAPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ DSAPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "DSAPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "DSAPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -67,9 +67,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "DSAPrims 12 February 2014 (i)"
+ "DSAPrims 23 February 2014 (i)"
#else
- "DSAPrims 12 February 2014 (e)"
+ "DSAPrims 23 February 2014 (e)"
#endif
;
static sqInt remainderDigitCount;
Modified: trunk/src/plugins/DropPlugin/DropPlugin.c
===================================================================
--- trunk/src/plugins/DropPlugin/DropPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/DropPlugin/DropPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:43 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:07 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- DropPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ DropPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "DropPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "DropPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -62,9 +62,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "DropPlugin 12 February 2014 (i)"
+ "DropPlugin 23 February 2014 (i)"
#else
- "DropPlugin 12 February 2014 (e)"
+ "DropPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/FFTPlugin/FFTPlugin.c
===================================================================
--- trunk/src/plugins/FFTPlugin/FFTPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/FFTPlugin/FFTPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:43 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:07 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- FFTPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ FFTPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "FFTPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "FFTPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -68,9 +68,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "FFTPlugin 12 February 2014 (i)"
+ "FFTPlugin 23 February 2014 (i)"
#else
- "FFTPlugin 12 February 2014 (e)"
+ "FFTPlugin 23 February 2014 (e)"
#endif
;
static sqInt nu;
Modified: trunk/src/plugins/FT2Plugin/FT2Plugin.c
===================================================================
--- trunk/src/plugins/FT2Plugin/FT2Plugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/FT2Plugin/FT2Plugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,4 +1,4 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:47 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:16 am */
/* Automatically generated by
FT2PluginCodeGenerator * FreeType-nice.442 uuid: 9895a884-7d42-4783-9fb8-1a71ef244e16
from
@@ -121,9 +121,9 @@
static FT_Library library;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "FT2Plugin 12 February 2014 (i)"
+ "FT2Plugin 23 February 2014 (i)"
#else
- "FT2Plugin 12 February 2014 (e)"
+ "FT2Plugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/FileCopyPlugin/FileCopyPlugin.c
===================================================================
--- trunk/src/plugins/FileCopyPlugin/FileCopyPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/FileCopyPlugin/FileCopyPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:47 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:16 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- FileCopyPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ FileCopyPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "FileCopyPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "FileCopyPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -57,9 +57,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "FileCopyPlugin 12 February 2014 (i)"
+ "FileCopyPlugin 23 February 2014 (i)"
#else
- "FileCopyPlugin 12 February 2014 (e)"
+ "FileCopyPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/FilePlugin/FilePlugin.c
===================================================================
--- trunk/src/plugins/FilePlugin/FilePlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/FilePlugin/FilePlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:43 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:07 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- FilePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ FilePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "FilePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "FilePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -100,9 +100,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "FilePlugin 12 February 2014 (i)"
+ "FilePlugin 23 February 2014 (i)"
#else
- "FilePlugin 12 February 2014 (e)"
+ "FilePlugin 23 February 2014 (e)"
#endif
;
static void * sCCPfn;
Modified: trunk/src/plugins/FloatArrayPlugin/FloatArrayPlugin.c
===================================================================
--- trunk/src/plugins/FloatArrayPlugin/FloatArrayPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/FloatArrayPlugin/FloatArrayPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:43 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:08 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- FloatArrayPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ FloatArrayPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "FloatArrayPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "FloatArrayPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -72,9 +72,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "FloatArrayPlugin 12 February 2014 (i)"
+ "FloatArrayPlugin 23 February 2014 (i)"
#else
- "FloatArrayPlugin 12 February 2014 (e)"
+ "FloatArrayPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/FloatMathPlugin/FloatMathPlugin.c
===================================================================
--- trunk/src/plugins/FloatMathPlugin/FloatMathPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/FloatMathPlugin/FloatMathPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:43 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:08 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- FloatMathPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ FloatMathPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "FloatMathPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "FloatMathPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -79,9 +79,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "FloatMathPlugin 12 February 2014 (i)"
+ "FloatMathPlugin 23 February 2014 (i)"
#else
- "FloatMathPlugin 12 February 2014 (e)"
+ "FloatMathPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/GeniePlugin/GeniePlugin.c
===================================================================
--- trunk/src/plugins/GeniePlugin/GeniePlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/GeniePlugin/GeniePlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:43 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:08 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- GeniePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ GeniePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "GeniePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "GeniePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -61,9 +61,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "GeniePlugin v2.0 12 February 2014 (i)"
+ "GeniePlugin v2.0 23 February 2014 (i)"
#else
- "GeniePlugin v2.0 12 February 2014 (e)"
+ "GeniePlugin v2.0 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/HostWindowPlugin/HostWindowPlugin.c
===================================================================
--- trunk/src/plugins/HostWindowPlugin/HostWindowPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/HostWindowPlugin/HostWindowPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:48 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:18 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- HostWindowPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ HostWindowPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "HostWindowPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "HostWindowPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -66,9 +66,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "HostWindowPlugin 12 February 2014 (i)"
+ "HostWindowPlugin 23 February 2014 (i)"
#else
- "HostWindowPlugin 12 February 2014 (e)"
+ "HostWindowPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/JPEGReadWriter2Plugin/JPEGReadWriter2Plugin.c
===================================================================
--- trunk/src/plugins/JPEGReadWriter2Plugin/JPEGReadWriter2Plugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/JPEGReadWriter2Plugin/JPEGReadWriter2Plugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:43 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:08 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- JPEGReadWriter2Plugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ JPEGReadWriter2Plugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "JPEGReadWriter2Plugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "JPEGReadWriter2Plugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -68,9 +68,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "JPEGReadWriter2Plugin 12 February 2014 (i)"
+ "JPEGReadWriter2Plugin 23 February 2014 (i)"
#else
- "JPEGReadWriter2Plugin 12 February 2014 (e)"
+ "JPEGReadWriter2Plugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/JPEGReaderPlugin/JPEGReaderPlugin.c
===================================================================
--- trunk/src/plugins/JPEGReaderPlugin/JPEGReaderPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/JPEGReaderPlugin/JPEGReaderPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:44 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:09 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- JPEGReaderPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ JPEGReaderPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "JPEGReaderPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "JPEGReaderPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -136,9 +136,9 @@
static sqInt jsReadLimit;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "JPEGReaderPlugin 12 February 2014 (i)"
+ "JPEGReaderPlugin 23 February 2014 (i)"
#else
- "JPEGReaderPlugin 12 February 2014 (e)"
+ "JPEGReaderPlugin 23 February 2014 (e)"
#endif
;
static int *residuals;
Modified: trunk/src/plugins/JoystickTabletPlugin/JoystickTabletPlugin.c
===================================================================
--- trunk/src/plugins/JoystickTabletPlugin/JoystickTabletPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/JoystickTabletPlugin/JoystickTabletPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:44 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:09 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- JoystickTabletPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ JoystickTabletPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "JoystickTabletPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "JoystickTabletPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -62,9 +62,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "JoystickTabletPlugin 12 February 2014 (i)"
+ "JoystickTabletPlugin 23 February 2014 (i)"
#else
- "JoystickTabletPlugin 12 February 2014 (e)"
+ "JoystickTabletPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/Klatt/Klatt.c
===================================================================
--- trunk/src/plugins/Klatt/Klatt.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/Klatt/Klatt.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:44 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:09 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- KlattSynthesizerPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ KlattSynthesizerPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "KlattSynthesizerPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "KlattSynthesizerPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -155,9 +155,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "Klatt 12 February 2014 (i)"
+ "Klatt 23 February 2014 (i)"
#else
- "Klatt 12 February 2014 (e)"
+ "Klatt 23 February 2014 (e)"
#endif
;
static float nlast;
Modified: trunk/src/plugins/LargeIntegers/LargeIntegers.c
===================================================================
--- trunk/src/plugins/LargeIntegers/LargeIntegers.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/LargeIntegers/LargeIntegers.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:44 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:10 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- LargeIntegersPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ LargeIntegersPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "LargeIntegersPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "LargeIntegersPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
Modified: trunk/src/plugins/LocalePlugin/LocalePlugin.c
===================================================================
--- trunk/src/plugins/LocalePlugin/LocalePlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/LocalePlugin/LocalePlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:44 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:10 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- LocalePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ LocalePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "LocalePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "LocalePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -71,9 +71,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "LocalePlugin 12 February 2014 (i)"
+ "LocalePlugin 23 February 2014 (i)"
#else
- "LocalePlugin 12 February 2014 (e)"
+ "LocalePlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/MIDIPlugin/MIDIPlugin.c
===================================================================
--- trunk/src/plugins/MIDIPlugin/MIDIPlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/MIDIPlugin/MIDIPlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:49 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:21 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- MIDIPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ MIDIPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "MIDIPlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "MIDIPlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -70,9 +70,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "MIDIPlugin 12 February 2014 (i)"
+ "MIDIPlugin 23 February 2014 (i)"
#else
- "MIDIPlugin 12 February 2014 (e)"
+ "MIDIPlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/Matrix2x3Plugin/Matrix2x3Plugin.c
===================================================================
--- trunk/src/plugins/Matrix2x3Plugin/Matrix2x3Plugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/Matrix2x3Plugin/Matrix2x3Plugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:45 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:10 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- Matrix2x3Plugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ Matrix2x3Plugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "Matrix2x3Plugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "Matrix2x3Plugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -74,9 +74,9 @@
static double m23ResultY;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "Matrix2x3Plugin 12 February 2014 (i)"
+ "Matrix2x3Plugin 23 February 2014 (i)"
#else
- "Matrix2x3Plugin 12 February 2014 (e)"
+ "Matrix2x3Plugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c
===================================================================
--- trunk/src/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/MiscPrimitivePlugin/MiscPrimitivePlugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:45 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:11 am */
/* Automatically generated by
- VMPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ VMPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- MiscPrimitivePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ MiscPrimitivePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
-static char __buildInfo[] = "MiscPrimitivePlugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763 " __DATE__ ;
+static char __buildInfo[] = "MiscPrimitivePlugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284 " __DATE__ ;
@@ -70,9 +70,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "MiscPrimitivePlugin 12 February 2014 (i)"
+ "MiscPrimitivePlugin 23 February 2014 (i)"
#else
- "MiscPrimitivePlugin 12 February 2014 (e)"
+ "MiscPrimitivePlugin 23 February 2014 (e)"
#endif
;
Modified: trunk/src/plugins/Mpeg3Plugin/Mpeg3Plugin.c
===================================================================
--- trunk/src/plugins/Mpeg3Plugin/Mpeg3Plugin.c 2014-02-20 02:06:56 UTC (rev 2869)
+++ trunk/src/plugins/Mpeg3Plugin/Mpeg3Plugin.c 2014-02-23 15:51:51 UTC (rev 2870)
@@ -1,10 +1,10 @@
-/* Smalltalk from Squeak4.5 with VMMaker 4.13.2 translated as C source on 12 February 2014 7:19:49 pm */
+/* Smalltalk from Squeak4.5 with VMMaker 4.13.3 translated as C source on 23 February 2014 10:39:21 am */
/* Automatically generated by
- SmartSyntaxPluginCodeGenerator * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ SmartSyntaxPluginCodeGenerator VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
from
- Mpeg3Plugin * VMMaker-dtl.340 uuid: 640fa600-e4e0-4cdd-ae74-c6cf1b51b763
+ Mpeg3Plugin VMMaker-dtl.342 uuid: b96b3f58-94e9-45e0-a1b5-833b62ca2284
*/
@@ Diff output truncated at 50000 characters. @@
1
0
David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.342.mcz
==================== Summary ====================
Name: VMMaker-dtl.342
Author: dtl
Time: 23 February 2014, 10:37:08.672 am
UUID: b96b3f58-94e9-45e0-a1b5-833b62ca2284
Ancestors: VMMaker-dtl.341
VMMaker 4.13.3
Make it possible to produce a working VM with inlining disabled.
To build a VM without inlining: A VMMaker instance has an #inline variable, set it false to disable inlining. During build, disable the gnufication step.
Changes are:
Fix BalloonEnginePlugin>>stepToNextBezierForward:at: by removing unneeded cCoerce (this was an earlier workaround for a slang generation bug, no longer relevant).
Rename accessors in ObjectMemory and Interpreter to prevent name clashes in generated code. For variable foo the accessors would be getFoo and setFoo. Accessors are required because the object memory and interpreter have been factored into separate hierarchies.
For variables that represent C arrays, provide accessors such as fooAt: and fooAt:put: for array access.
=============== Diff against VMMaker-dtl.341 ===============
Item was changed:
----- Method: BalloonEnginePlugin>>stepToNextBezierForward:at: (in category 'beziers-simple') -----
stepToNextBezierForward: updateData at: yValue
+ "Incrementally step to the next scan line in the given bezier update data."
- "Incrementally step to the next scan line in the given bezier update data.
- Note: This method has been written so that inlining works, e.g.,
- not declaring updateData as 'int*' but casting it on every use."
| minY lastX lastY fwDx fwDy |
<inline: true>
+ <var: #updateData type: 'int *'>
+ lastX := updateData at: GBUpdateX.
+ lastY := updateData at: GBUpdateY.
+ fwDx := updateData at: GBUpdateDX.
+ fwDy := updateData at: GBUpdateDY.
- lastX := (self cCoerce: updateData to: 'int*') at: GBUpdateX.
- lastY := (self cCoerce: updateData to: 'int*') at: GBUpdateY.
- fwDx := (self cCoerce: updateData to: 'int*') at: GBUpdateDX.
- fwDy := (self cCoerce: updateData to: 'int*') at: GBUpdateDY.
minY := yValue * 256.
"Step as long as we haven't yet reached minY and also
as long as fwDy is greater than zero thus stepping down.
Note: The test for fwDy should not be necessary in theory
but is a good insurance in practice."
[minY > lastY and:[fwDy >= 0]] whileTrue:[
lastX := lastX + ((fwDx + 16r8000) // 16r10000).
lastY := lastY + ((fwDy + 16r8000) // 16r10000).
+ fwDx := fwDx + (updateData at: GBUpdateDDX).
+ fwDy := fwDy + (updateData at: GBUpdateDDY).
- fwDx := fwDx + ((self cCoerce: updateData to: 'int*') at: GBUpdateDDX).
- fwDy := fwDy + ((self cCoerce: updateData to: 'int*') at: GBUpdateDDY).
].
+ updateData at: GBUpdateX put: lastX.
+ updateData at: GBUpdateY put: lastY.
+ updateData at: GBUpdateDX put: fwDx.
+ updateData at: GBUpdateDY put: fwDy.
- (self cCoerce: updateData to: 'int*') at: GBUpdateX put: lastX.
- (self cCoerce: updateData to: 'int*') at: GBUpdateY put: lastY.
- (self cCoerce: updateData to: 'int*') at: GBUpdateDX put: fwDx.
- (self cCoerce: updateData to: 'int*') at: GBUpdateDY put: fwDy.
^lastX // 256
!
Item was added:
+ ----- Method: ClassicObjectMemory>>getYoungStart (in category 'accessing') -----
+ getYoungStart
+ <returnTypeC: #usqInt>
+ ^youngStart!
Item was added:
+ ----- Method: ClassicObjectMemory>>startOfFreeSpace (in category 'accessing') -----
+ startOfFreeSpace
+ <returnTypeC: #usqInt>
+ ^freeBlock!
Item was removed:
- ----- Method: ClassicObjectMemory>>youngStart (in category 'accessing') -----
- youngStart
- ^youngStart!
Item was changed:
----- Method: Interpreter>>activateNewMethod (in category 'message sending') -----
activateNewMethod
| newContext methodHeader initialIP tempCount nilOop where |
methodHeader := self headerOf: newMethod.
newContext := objectMemory allocateOrRecycleContext: (methodHeader bitAnd: LargeContextBit).
initialIP := ((LiteralStart + (self literalCountOfHeader: methodHeader)) * objectMemory bytesPerWord) + 1.
tempCount := (methodHeader >> 19) bitAnd: 16r3F.
"Assume: newContext will be recorded as a root if necessary by the
call to newActiveContext: below, so we can use unchecked stores."
where := newContext + objectMemory baseHeaderSize.
objectMemory longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
objectMemory longAt: where + (InstructionPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: initialIP).
objectMemory longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
objectMemory longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
+ objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory getNilObj.
- objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory nilObj.
"Copy the receiver and arguments..."
0 to: argumentCount do:
[:i | objectMemory longAt: where + ((ReceiverIndex+i) << objectMemory shiftForWord) put: (self stackValue: argumentCount-i)].
"clear remaining temps to nil in case it has been recycled"
+ nilOop := objectMemory getNilObj.
- nilOop := objectMemory nilObj.
argumentCount+1+ReceiverIndex to: tempCount+ReceiverIndex do:
[:i | objectMemory longAt: where + (i << objectMemory shiftForWord) put: nilOop].
self pop: argumentCount + 1.
reclaimableContextCount := reclaimableContextCount + 1.
self newActiveContext: newContext.!
Item was changed:
----- Method: Interpreter>>assertClassOf:is: (in category 'utilities') -----
assertClassOf: oop is: classOop
"Succeed if the given (non-integer) object is an instance of the given class. Fail if the object is an integer."
| ccIndex cl |
<inline: true>
(objectMemory isIntegerObject: oop)
ifTrue: [ self primitiveFail. ^ nil ].
ccIndex := ((objectMemory baseHeader: oop) >> 12) bitAnd: 16r1F.
ccIndex = 0
ifTrue: [ cl := ((objectMemory classHeader: oop) bitAnd: objectMemory allButTypeMask) ]
ifFalse: [
"look up compact class"
cl := (objectMemory fetchPointer: (ccIndex - 1)
+ ofObject: (objectMemory fetchPointer: CompactClasses ofObject: objectMemory getSpecialObjectsOop))].
- ofObject: (objectMemory fetchPointer: CompactClasses ofObject: objectMemory specialObjectsOop))].
self success: cl = classOop.
!
Item was changed:
----- Method: Interpreter>>booleanCheat: (in category 'utilities') -----
booleanCheat: cond
"cheat the interpreter out of the pleasure of handling the next bytecode IFF it is a jump-on-boolean. Which it is, often enough when the current bytecode is something like bytecodePrimEqual"
| bytecode offset |
<inline: true>
bytecode := self fetchByte. "assume next bytecode is jumpIfFalse (99%)"
self internalPop: 2.
(bytecode < 160 and: [bytecode > 151]) ifTrue: [ "short jumpIfFalse"
cond
ifTrue: [^ self fetchNextBytecode]
ifFalse: [^ self jump: bytecode - 151]].
bytecode = 172 ifTrue: [ "long jumpIfFalse"
offset := self fetchByte.
cond
ifTrue: [^ self fetchNextBytecode]
ifFalse: [^ self jump: offset]].
"not followed by a jumpIfFalse; undo instruction fetch and push boolean result"
localIP := localIP - 1.
self fetchNextBytecode.
cond
+ ifTrue: [self internalPush: objectMemory getTrueObj]
+ ifFalse: [self internalPush: objectMemory getFalseObj].
- ifTrue: [self internalPush: objectMemory trueObj]
- ifFalse: [self internalPush: objectMemory falseObj].
!
Item was changed:
----- Method: Interpreter>>booleanValueOf: (in category 'utilities') -----
booleanValueOf: obj
"convert true and false (Smalltalk) to true or false(C)"
+ obj = objectMemory getTrueObj ifTrue: [ ^ true ].
+ obj = objectMemory getFalseObj ifTrue: [ ^ false ].
- obj = objectMemory trueObj ifTrue: [ ^ true ].
- obj = objectMemory falseObj ifTrue: [ ^ false ].
self primitiveFail.
^ nil!
Item was changed:
----- Method: Interpreter>>byteSwapByteObjects (in category 'image save/restore') -----
byteSwapByteObjects
"Byte-swap the words of all bytes objects in the image. This returns these objects to their original byte ordering after blindly byte-swapping the entire image."
+ self byteSwapByteObjectsFrom: objectMemory firstObject to: objectMemory getEndOfMemory!
- self byteSwapByteObjectsFrom: objectMemory firstObject to: objectMemory endOfMemory!
Item was changed:
----- Method: Interpreter>>capturePendingFinalizationSignals (in category 'debug support') -----
capturePendingFinalizationSignals
+ objectMemory setStatpendingFinalizationSignals: pendingFinalizationSignals.
- objectMemory statpendingFinalizationSignals: pendingFinalizationSignals.
!
Item was changed:
----- Method: Interpreter>>changeClassOf:to: (in category 'object access primitives') -----
changeClassOf: rcvr to: argClass
"Change the class of the receiver into the class specified by the argument given that the format of the receiver matches the format of the argument. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have."
| classHdr sizeHiBits byteSize argFormat rcvrFormat ccIndex |
"Check what the format of the class says"
classHdr := objectMemory formatOfClass: argClass. "Low 2 bits are 0"
"Compute the size of instances of the class (used for fixed field classes only)"
sizeHiBits := (classHdr bitAnd: 16r60000) >> 9.
classHdr := classHdr bitAnd: 16r1FFFF.
byteSize := (classHdr bitAnd: objectMemory sizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
"Check the receiver's format against that of the class"
argFormat := (classHdr >> 8) bitAnd: 16rF.
rcvrFormat := objectMemory formatOf: rcvr.
argFormat = rcvrFormat ifFalse:[^self primitiveFail]. "no way"
"For fixed field classes, the sizes must match.
Note: byteSize-4 because base header is included in class size."
argFormat < 2 ifTrue:[(byteSize - objectMemory baseHeaderSize) = (objectMemory byteSizeOf: rcvr) ifFalse:[^self primitiveFail]].
(objectMemory headerType: rcvr) = HeaderTypeShort
ifTrue:[ "Compact classes. Check if the arg's class is compact and exchange ccIndex"
ccIndex := classHdr bitAnd: CompactClassMask.
ccIndex = 0 ifTrue:[^self primitiveFail]. "class is not compact"
objectMemory longAt: rcvr put:
(((objectMemory longAt: rcvr) bitAnd: CompactClassMask bitInvert32)
bitOr: ccIndex)]
ifFalse:["Exchange the class pointer, which could make rcvr a root for argClass"
objectMemory longAt: rcvr - objectMemory baseHeaderSize put: (argClass bitOr: (objectMemory headerType: rcvr)).
+ (objectMemory oop: rcvr isLessThan: objectMemory getYoungStart)
- (objectMemory oop: rcvr isLessThan: objectMemory youngStart)
ifTrue: [objectMemory possibleRootStoreInto: rcvr value: argClass]]!
Item was changed:
----- Method: Interpreter>>checkForInterrupts (in category 'process primitive support') -----
checkForInterrupts
"Check for possible interrupts and handle one if necessary."
| sema now |
<inline: false>
"Mask so same wrapping as primitiveMillisecondClock"
now := self ioMSecs bitAnd: MillisecondClockMask.
self interruptCheckForced ifFalse: [
"don't play with the feedback if we forced a check. It only makes life difficult"
now - lastTick < interruptChecksEveryNms
ifTrue: ["wrapping is not a concern, it'll get caught quickly
enough. This clause is trying to keep a reasonable
guess of how many times per interruptChecksEveryNms we are calling
quickCheckForInterrupts. Not sure how effective it really is."
interruptCheckCounterFeedBackReset := interruptCheckCounterFeedBackReset + 10]
ifFalse: [interruptCheckCounterFeedBackReset <= 1000
ifTrue: [interruptCheckCounterFeedBackReset := 1000]
ifFalse: [interruptCheckCounterFeedBackReset := interruptCheckCounterFeedBackReset - 12]]].
"reset the interrupt check counter"
interruptCheckCounter := interruptCheckCounterFeedBackReset.
+ objectMemory getSignalLowSpace
+ ifTrue: [objectMemory setSignalLowSpace: false. "reset flag"
- objectMemory signalLowSpace
- ifTrue: [objectMemory signalLowSpace: false. "reset flag"
sema := objectMemory splObj: TheLowSpaceSemaphore.
+ sema = objectMemory getNilObj ifFalse: [self synchronousSignal: sema]].
- sema = objectMemory nilObj ifFalse: [self synchronousSignal: sema]].
now < lastTick
ifTrue: ["millisecond clock wrapped so correct the nextPollTick"
nextPollTick := nextPollTick - MillisecondClockMask - 1].
now >= nextPollTick
ifTrue: [self ioProcessEvents.
"sets interruptPending if interrupt key pressed"
nextPollTick := now + 200
"msecs to wait before next call to ioProcessEvents.
Note that strictly speaking we might need to update
'now' at this point since ioProcessEvents could take a
very long time on some platforms"].
interruptPending
ifTrue: [interruptPending := false.
"reset interrupt flag"
sema := objectMemory splObj: TheInterruptSemaphore.
+ sema = objectMemory getNilObj
- sema = objectMemory nilObj
ifFalse: [self synchronousSignal: sema]].
nextWakeupTick ~= 0
ifTrue: [now < lastTick
ifTrue: ["the clock has wrapped. Subtract the wrap
interval from nextWakeupTick - this might just
possibly result in 0. Since this is used as a flag
value for 'no timer' we do the 0 check above"
nextWakeupTick := nextWakeupTick - MillisecondClockMask - 1].
now >= nextWakeupTick
ifTrue: [nextWakeupTick := 0.
"set timer interrupt to 0 for 'no timer'"
sema := objectMemory splObj: TheTimerSemaphore.
+ sema = objectMemory getNilObj ifFalse: [self synchronousSignal: sema]]].
- sema = objectMemory nilObj ifFalse: [self synchronousSignal: sema]]].
"signal any pending finalizations"
pendingFinalizationSignals > 0
ifTrue: [sema := objectMemory splObj: TheFinalizationSemaphore.
(objectMemory fetchClassOf: sema) = (objectMemory splObj: ClassSemaphore)
ifTrue: [self synchronousSignal: sema].
pendingFinalizationSignals := 0].
"signal all semaphores in semaphoresToSignal"
(semaphoresToSignalCountA > 0 or: [semaphoresToSignalCountB > 0])
ifTrue: [self signalExternalSemaphores].
"update the tracking value"
lastTick := now!
Item was changed:
----- Method: Interpreter>>commonReturn (in category 'return bytecodes') -----
commonReturn
"Note: Assumed to be inlined into the dispatch loop."
| nilOop thisCntx contextOfCaller localCntx localVal unwindMarked |
<inline: true>
self sharedCodeNamed: 'commonReturn' inCase: 120.
+ nilOop := objectMemory getNilObj. "keep in a register"
- nilOop := objectMemory nilObj. "keep in a register"
thisCntx := activeContext.
localCntx := localReturnContext.
localVal := localReturnValue.
"make sure we can return to the given context"
((localCntx = nilOop) or:
[(objectMemory fetchPointer: InstructionPointerIndex ofObject: localCntx) = nilOop]) ifTrue: [
"error: sender's instruction pointer or context is nil; cannot return"
^self internalCannotReturn: localVal].
"If this return is not to our immediate predecessor (i.e. from a method to its sender, or from a block to its caller), scan the stack for the first unwind marked context and inform this context and let it deal with it. This provides a chance for ensure unwinding to occur."
thisCntx := objectMemory fetchPointer: SenderIndex ofObject: activeContext.
"Just possibly a faster test would be to compare the homeContext and activeContext - they are of course different for blocks. Thus we might be able to optimise a touch by having a different returnTo for the blockreteurn (since we know that must return to caller) and then if active ~= home we must be doing a non-local return. I think. Maybe."
[thisCntx = localCntx] whileFalse: [
thisCntx = nilOop ifTrue:[
"error: sender's instruction pointer or context is nil; cannot return"
^self internalCannotReturn: localVal].
"Climb up stack towards localCntx. Break out to a send of #aboutToReturn:through: if an unwind marked context is found"
unwindMarked := self isUnwindMarked: thisCntx.
unwindMarked ifTrue:[
"context is marked; break out"
^self internalAboutToReturn: localVal through: thisCntx].
thisCntx := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
].
"If we get here there is no unwind to worry about. Simply terminate the stack up to the localCntx - often just the sender of the method"
thisCntx := activeContext.
[thisCntx = localCntx]
whileFalse:
["climb up stack to localCntx"
contextOfCaller := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
"zap exited contexts so any future attempted use will be caught"
objectMemory storePointerUnchecked: SenderIndex ofObject: thisCntx withValue: nilOop.
objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: thisCntx withValue: nilOop.
reclaimableContextCount > 0 ifTrue:
["try to recycle this context"
reclaimableContextCount := reclaimableContextCount - 1.
objectMemory recycleContextIfPossible: thisCntx].
thisCntx := contextOfCaller].
activeContext := thisCntx.
+ (objectMemory oop: thisCntx isLessThan: objectMemory getYoungStart) ifTrue: [ objectMemory beRootIfOld: thisCntx ].
- (objectMemory oop: thisCntx isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: thisCntx ].
self internalFetchContextRegisters: thisCntx. "updates local IP and SP"
self fetchNextBytecode.
self internalPush: localVal.
!
Item was changed:
----- Method: Interpreter>>context:hasSender: (in category 'contexts') -----
context: thisCntx hasSender: aContext
"Does thisCntx have aContext in its sender chain?"
| s nilOop |
<inline: true>
thisCntx == aContext ifTrue: [^false].
+ nilOop := objectMemory getNilObj.
- nilOop := objectMemory nilObj.
s := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
[s == nilOop]
whileFalse: [s == aContext ifTrue: [^true].
s := objectMemory fetchPointer: SenderIndex ofObject: s].
^false!
Item was changed:
----- Method: Interpreter>>dumpImage: (in category 'image save/restore') -----
dumpImage: fileName
"Dump the entire image out to the given file. Intended for debugging only."
| f dataSize result |
<export: true>
<var: #fileName type: 'char *'>
<var: #f type: 'sqImageFile'>
f := self cCode: 'sqImageFileOpen(fileName, "wb")'.
f = nil ifTrue: [^-1].
+ dataSize := objectMemory getEndOfMemory - objectMemory startOfMemory.
- dataSize := objectMemory endOfMemory - objectMemory startOfMemory.
result := self cCode: 'sqImageFileWrite(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
self cCode: 'sqImageFileClose(f)'.
^result
!
Item was changed:
----- Method: Interpreter>>fetchContextRegisters: (in category 'contexts') -----
fetchContextRegisters: activeCntx
"Note: internalFetchContextRegisters: should track changes to this method."
| tmp |
<inline: true>
tmp := objectMemory fetchPointer: MethodIndex ofObject: activeCntx.
(objectMemory isIntegerObject: tmp)
ifTrue: ["if the MethodIndex field is an integer, activeCntx is a block context"
tmp := objectMemory fetchPointer: HomeIndex ofObject: activeCntx.
+ (objectMemory oop: tmp isLessThan: objectMemory getYoungStart) ifTrue: [objectMemory beRootIfOld: tmp]]
- (objectMemory oop: tmp isLessThan: objectMemory youngStart) ifTrue: [objectMemory beRootIfOld: tmp]]
ifFalse: ["otherwise, it is a method context and is its own home context "
tmp := activeCntx].
theHomeContext := tmp.
receiver := objectMemory fetchPointer: ReceiverIndex ofObject: tmp.
method := objectMemory fetchPointer: MethodIndex ofObject: tmp.
"the instruction pointer is a pointer variable equal to
method oop + ip + objectMemory baseHeaderSize
-1 for 0-based addressing of fetchByte
-1 because it gets incremented BEFORE fetching currentByte "
tmp := self quickFetchInteger: InstructionPointerIndex ofObject: activeCntx.
instructionPointer := method + tmp + objectMemory baseHeaderSize - 2.
"the stack pointer is a pointer variable also..."
tmp := self quickFetchInteger: StackPointerIndex ofObject: activeCntx.
stackPointer := activeCntx + objectMemory baseHeaderSize + (TempFrameStart + tmp - 1 * objectMemory bytesPerWord)!
Item was changed:
----- Method: Interpreter>>findClassOfMethod:forReceiver: (in category 'debug support') -----
findClassOfMethod: meth forReceiver: rcvr
| currClass classDict classDictSize methodArray i done |
currClass := objectMemory fetchClassOf: rcvr.
done := false.
[done] whileFalse: [
classDict := objectMemory fetchPointer: MessageDictionaryIndex ofObject: currClass.
classDictSize := objectMemory fetchWordLengthOf: classDict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i < (classDictSize - SelectorStart)] whileTrue: [
meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: [ ^currClass ].
i := i + 1.
].
currClass := objectMemory fetchPointer: SuperclassIndex ofObject: currClass.
+ done := currClass = objectMemory getNilObj.
- done := currClass = objectMemory nilObj.
].
^objectMemory fetchClassOf: rcvr "method not found in superclass chain"!
Item was changed:
----- Method: Interpreter>>findSelectorOfMethod:forReceiver: (in category 'debug support') -----
findSelectorOfMethod: meth forReceiver: rcvr
| currClass done classDict classDictSize methodArray i |
currClass := objectMemory fetchClassOf: rcvr.
done := false.
[done] whileFalse: [
classDict := objectMemory fetchPointer: MessageDictionaryIndex ofObject: currClass.
classDictSize := objectMemory fetchWordLengthOf: classDict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict.
i := 0.
[i <= (classDictSize - SelectorStart)] whileTrue: [
meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: [
^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)
].
i := i + 1.
].
currClass := objectMemory fetchPointer: SuperclassIndex ofObject: currClass.
+ done := currClass = objectMemory getNilObj.
- done := currClass = objectMemory nilObj.
].
+ ^ objectMemory getNilObj "method not found in superclass chain"!
- ^ objectMemory nilObj "method not found in superclass chain"!
Item was changed:
----- Method: Interpreter>>flushExternalPrimitives (in category 'plugin primitive support') -----
flushExternalPrimitives
"Flush the references to external functions from plugin
primitives. This will force a reload of those primitives when
accessed next.
Note: We must flush the method cache here so that any
failed primitives are looked up again."
| oop primIdx |
oop := objectMemory firstObject.
+ [objectMemory oop: oop isLessThan: objectMemory getEndOfMemory]
- [objectMemory oop: oop isLessThan: objectMemory endOfMemory]
whileTrue: [(objectMemory isFreeObject: oop)
ifFalse: [(objectMemory isCompiledMethod: oop)
ifTrue: ["This is a compiled method"
primIdx := self primitiveIndexOf: oop.
primIdx = PrimitiveExternalCallIndex
ifTrue: ["It's primitiveExternalCall"
self flushExternalPrimitiveOf: oop]]].
oop := objectMemory objectAfter: oop].
self flushMethodCache.
self flushExternalPrimitiveTable!
Item was removed:
- ----- Method: Interpreter>>imageFormatInitialVersion (in category 'image save/restore') -----
- imageFormatInitialVersion
- "This is the image format version that was saved to in the previous image snapshot.
- The interpreter checks this value at image load time to determine if it is able to load
- and run the image file. When the image is next saved, it will be saved using the current
- imageFormatVersion, which may be different from imageFormatInitialVersion. "
- ^imageFormatInitialVersion!
Item was changed:
----- Method: Interpreter>>includesBehavior:ThatOf: (in category 'plugin primitive support') -----
includesBehavior: aClass ThatOf: aSuperclass
"Return the equivalent of
aClass includesBehavior: aSuperclass.
Note: written for efficiency and better inlining (only 1 temp)"
| theClass |
<inline: true>
+ aSuperclass = objectMemory getNilObj ifTrue:
- aSuperclass = objectMemory nilObj ifTrue:
[^false].
theClass := aClass.
[theClass = aSuperclass ifTrue:
[^true].
+ theClass ~= objectMemory getNilObj] whileTrue:
- theClass ~= objectMemory nilObj] whileTrue:
[theClass := self superclassOf: theClass].
^false!
Item was added:
+ ----- Method: Interpreter>>initialImageFormatVersion (in category 'image save/restore') -----
+ initialImageFormatVersion
+ "This is the image format version that was saved to in the previous image snapshot.
+ The interpreter checks this value at image load time to determine if it is able to load
+ and run the image file. When the image is next saved, it will be saved using the current
+ imageFormatVersion, which may be different from imageFormatInitialVersion.
+ Selector name chosen to avoid conflict with variable declaration in generated code."
+ ^imageFormatInitialVersion!
Item was changed:
----- Method: Interpreter>>initializeInterpreter: (in category 'initialization') -----
initializeInterpreter: bytesToShift
"Initialize Interpreter state before starting execution of a new image."
interpreterProxy := self sqGetInterpreterProxy.
self dummyReferToProxy.
objectMemory initializeObjectMemory: bytesToShift.
self initCompilerHooks.
+ activeContext := objectMemory getNilObj.
+ theHomeContext := objectMemory getNilObj.
+ method := objectMemory getNilObj.
+ receiver := objectMemory getNilObj.
+ messageSelector := objectMemory getNilObj.
+ newMethod := objectMemory getNilObj.
+ methodClass := objectMemory getNilObj.
+ lkupClass := objectMemory getNilObj.
+ receiverClass := objectMemory getNilObj.
+ newNativeMethod := objectMemory getNilObj.
- activeContext := objectMemory nilObj.
- theHomeContext := objectMemory nilObj.
- method := objectMemory nilObj.
- receiver := objectMemory nilObj.
- messageSelector := objectMemory nilObj.
- newMethod := objectMemory nilObj.
- methodClass := objectMemory nilObj.
- lkupClass := objectMemory nilObj.
- receiverClass := objectMemory nilObj.
- newNativeMethod := objectMemory nilObj.
self flushMethodCache.
self loadInitialContext.
self initialCleanup.
interruptCheckCounter := 0.
interruptCheckCounterFeedBackReset := 1000.
interruptChecksEveryNms := 1.
nextPollTick := 0.
nextWakeupTick := 0.
lastTick := 0.
interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
interruptPending := false.
semaphoresUseBufferA := true.
semaphoresToSignalCountA := 0.
semaphoresToSignalCountB := 0.
deferDisplayUpdates := false.
pendingFinalizationSignals := 0.
globalSessionID := 0.
[globalSessionID = 0]
whileTrue: [globalSessionID := self
cCode: 'time(NULL) + ioMSecs()'
inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
jmpDepth := 0.
jmpMax := MaxJumpBuf. "xxxx: Must match the definition of jmpBuf and suspendedCallbacks"
!
Item was changed:
----- Method: Interpreter>>internalActivateNewMethod (in category 'message sending') -----
internalActivateNewMethod
| methodHeader newContext tempCount argCount2 needsLarge where |
<inline: true>
methodHeader := self headerOf: newMethod.
needsLarge := methodHeader bitAnd: LargeContextBit.
+ (needsLarge = 0 and: [objectMemory getFreeContexts ~= objectMemory nilContext])
+ ifTrue: [newContext := objectMemory getFreeContexts.
- (needsLarge = 0 and: [objectMemory freeContexts ~= objectMemory nilContext])
- ifTrue: [newContext := objectMemory freeContexts.
objectMemory setFreeContextsAfter: newContext]
ifFalse: ["Slower call for large contexts or empty free list"
self externalizeIPandSP.
newContext := objectMemory allocateOrRecycleContext: needsLarge.
self internalizeIPandSP].
tempCount := (methodHeader >> 19) bitAnd: 16r3F.
"Assume: newContext will be recorded as a root if necessary by the
call to newActiveContext: below, so we can use unchecked stores."
where := newContext + objectMemory baseHeaderSize.
objectMemory longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
objectMemory longAt: where + (InstructionPointerIndex << objectMemory shiftForWord)
put: (objectMemory integerObjectOf: (((LiteralStart + (self literalCountOfHeader: methodHeader)) * objectMemory bytesPerWord) + 1)).
objectMemory longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
objectMemory longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
+ objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory getNilObj.
- objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory nilObj.
"Copy the receiver and arguments..."
argCount2 := argumentCount.
0 to: argCount2 do:
[:i | objectMemory longAt: where + ((ReceiverIndex+i) << objectMemory shiftForWord) put: (self internalStackValue: argCount2-i)].
"clear remaining temps to nil in case it has been recycled"
+ methodHeader := objectMemory getNilObj. "methodHeader here used just as faster (register?) temp"
- methodHeader := objectMemory nilObj. "methodHeader here used just as faster (register?) temp"
argCount2+1+ReceiverIndex to: tempCount+ReceiverIndex do:
[:i | objectMemory longAt: where + (i << objectMemory shiftForWord) put: methodHeader].
self internalPop: argCount2 + 1.
reclaimableContextCount := reclaimableContextCount + 1.
self internalNewActiveContext: newContext.
!
Item was changed:
----- Method: Interpreter>>internalExecuteNewMethod (in category 'message sending') -----
internalExecuteNewMethod
| localPrimIndex delta nArgs |
<inline: true>
localPrimIndex := primitiveIndex.
localPrimIndex > 0
ifTrue: [(localPrimIndex > 255
and: [localPrimIndex < 520])
ifTrue: ["Internal return instvars"
localPrimIndex >= 264
ifTrue: [^ self internalPop: 1 thenPush: (objectMemory fetchPointer: localPrimIndex - 264 ofObject: self internalStackTop)]
ifFalse: ["Internal return constants"
localPrimIndex = 256 ifTrue: [^ nil].
+ localPrimIndex = 257 ifTrue: [^ self internalPop: 1 thenPush: objectMemory getTrueObj].
+ localPrimIndex = 258 ifTrue: [^ self internalPop: 1 thenPush: objectMemory getFalseObj].
+ localPrimIndex = 259 ifTrue: [^ self internalPop: 1 thenPush: objectMemory getNilObj].
- localPrimIndex = 257 ifTrue: [^ self internalPop: 1 thenPush: objectMemory trueObj].
- localPrimIndex = 258 ifTrue: [^ self internalPop: 1 thenPush: objectMemory falseObj].
- localPrimIndex = 259 ifTrue: [^ self internalPop: 1 thenPush: objectMemory nilObj].
^ self internalPop: 1 thenPush: (objectMemory integerObjectOf: localPrimIndex - 261)]]
ifFalse: [self externalizeIPandSP.
"self primitiveResponse. <-replaced with manually inlined code"
DoBalanceChecks
ifTrue: ["check stack balance"
nArgs := argumentCount.
delta := stackPointer - activeContext].
self initPrimCall.
self dispatchFunctionPointer: primitiveFunctionPointer. "branch direct to prim function from address stored in mcache"
DoBalanceChecks
ifTrue: [(self balancedStack: delta afterPrimitive: localPrimIndex withArgs: nArgs)
ifFalse: [self printUnbalancedStack: localPrimIndex]].
self internalizeIPandSP.
self successful
ifTrue: [self browserPluginReturnIfNeeded.
^ nil]]].
"if not primitive, or primitive failed, activate the method"
self internalActivateNewMethod.
"check for possible interrupts at each real send"
self internalQuickCheckForInterrupts!
Item was changed:
----- Method: Interpreter>>internalFetchContextRegisters: (in category 'contexts') -----
internalFetchContextRegisters: activeCntx
"Inlined into return bytecodes. The only difference between this method and fetchContextRegisters: is that this method sets the local IP and SP."
| tmp |
<inline: true>
tmp := objectMemory fetchPointer: MethodIndex ofObject: activeCntx.
(objectMemory isIntegerObject: tmp) ifTrue: [
"if the MethodIndex field is an integer, activeCntx is a block context"
tmp := objectMemory fetchPointer: HomeIndex ofObject: activeCntx.
+ (objectMemory oop: tmp isLessThan: objectMemory getYoungStart) ifTrue: [ objectMemory beRootIfOld: tmp ].
- (objectMemory oop: tmp isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: tmp ].
] ifFalse: [
"otherwise, it is a method context and is its own home context"
tmp := activeCntx.
].
localHomeContext := tmp.
receiver := objectMemory fetchPointer: ReceiverIndex ofObject: tmp.
method := objectMemory fetchPointer: MethodIndex ofObject: tmp.
"the instruction pointer is a pointer variable equal to
method oop + ip + objectMemory baseHeaderSize
-1 for 0-based addressing of fetchByte
-1 because it gets incremented BEFORE fetching currentByte"
tmp := self quickFetchInteger: InstructionPointerIndex ofObject: activeCntx.
localIP := objectMemory pointerForOop: method + tmp + objectMemory baseHeaderSize - 2.
"the stack pointer is a pointer variable also..."
tmp := self quickFetchInteger: StackPointerIndex ofObject: activeCntx.
localSP := objectMemory pointerForOop: activeCntx + objectMemory baseHeaderSize + ((TempFrameStart + tmp - 1) * objectMemory bytesPerWord)!
Item was changed:
----- Method: Interpreter>>internalJustActivateNewMethod (in category 'message sending') -----
internalJustActivateNewMethod
"Activate the new method but *do not* copy receiver or arguments from activeContext."
| methodHeader initialIP newContext tempCount needsLarge where |
<inline: true>
methodHeader := self headerOf: newMethod.
needsLarge := methodHeader bitAnd: LargeContextBit.
+ (needsLarge = 0 and: [objectMemory getFreeContexts ~= objectMemory nilContext])
+ ifTrue: [newContext := objectMemory getFreeContexts.
- (needsLarge = 0 and: [objectMemory freeContexts ~= objectMemory nilContext])
- ifTrue: [newContext := objectMemory freeContexts.
objectMemory setFreeContextsAfter: newContext]
ifFalse: ["Slower call for large contexts or empty free list"
newContext := objectMemory allocateOrRecycleContext: needsLarge].
initialIP := ((LiteralStart + (self literalCountOfHeader: methodHeader)) * objectMemory bytesPerWord) + 1.
tempCount := (methodHeader >> 19) bitAnd: 16r3F.
"Assume: newContext will be recorded as a root if necessary by the
call to newActiveContext: below, so we can use unchecked stores."
where := newContext + objectMemory baseHeaderSize.
objectMemory longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
objectMemory longAt: where + (InstructionPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: initialIP).
objectMemory longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
objectMemory longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
"Set the receiver..."
objectMemory longAt: where + (ReceiverIndex << objectMemory shiftForWord) put: receiver.
"clear all args and temps to nil in case it has been recycled"
+ needsLarge := objectMemory getNilObj. "needsLarge here used just as faster (register?) temp"
- needsLarge := objectMemory nilObj. "needsLarge here used just as faster (register?) temp"
ReceiverIndex + 1 to: tempCount + ReceiverIndex do:
[:i | objectMemory longAt: where + (i << objectMemory shiftForWord) put: needsLarge].
reclaimableContextCount := reclaimableContextCount + 1.
activeContext := newContext.!
Item was changed:
----- Method: Interpreter>>internalNewActiveContext: (in category 'contexts') -----
internalNewActiveContext: aContext
"The only difference between this method and newActiveContext: is that this method uses internal context registers."
<inline: true>
self internalStoreContextRegisters: activeContext.
+ (objectMemory oop: aContext isLessThan: objectMemory getYoungStart) ifTrue: [ objectMemory beRootIfOld: aContext ].
- (objectMemory oop: aContext isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: aContext ].
activeContext := aContext.
self internalFetchContextRegisters: aContext.!
Item was changed:
----- Method: Interpreter>>internalPrimitiveValue (in category 'control primitives') -----
internalPrimitiveValue
| newContext blockArgumentCount initialIP |
<inline: true>
self sharedCodeNamed: 'commonPrimitiveValue' inCase: 201.
self initPrimCall.
newContext := self internalStackValue: argumentCount.
self assertClassOf: newContext is: (objectMemory splObj: ClassBlockContext).
blockArgumentCount := self argumentCountOfBlock: newContext.
+ self success: (argumentCount = blockArgumentCount and: [(objectMemory fetchPointer: CallerIndex ofObject: newContext) = objectMemory getNilObj]).
- self success: (argumentCount = blockArgumentCount and: [(objectMemory fetchPointer: CallerIndex ofObject: newContext) = objectMemory nilObj]).
self successful
ifTrue: ["This code assumes argCount can only = 0 or 1"
argumentCount = 1
ifTrue: [objectMemory storePointer: TempFrameStart ofObject: newContext withValue: self internalStackTop].
self internalPop: argumentCount + 1.
"copy the initialIP value to the ip slot"
initialIP := objectMemory fetchPointer: InitialIPIndex ofObject: newContext.
objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: newContext withValue: initialIP.
self storeStackPointerValue: argumentCount inContext: newContext.
objectMemory storePointerUnchecked: CallerIndex ofObject: newContext withValue: activeContext.
self internalNewActiveContext: newContext]
ifFalse: [messageSelector := self specialSelector: 25 + argumentCount.
self normalSend]!
Item was changed:
----- Method: Interpreter>>is:KindOf: (in category 'plugin primitive support') -----
is: oop KindOf: className
"Support for external primitives."
| oopClass |
<var: #className type: 'char *'>
oopClass := objectMemory fetchClassOf: oop.
+ [oopClass == objectMemory getNilObj] whileFalse:[
- [oopClass == objectMemory nilObj] whileFalse:[
(self classNameOf: oopClass Is: className) ifTrue:[^true].
oopClass := self superclassOf: oopClass].
^false!
Item was changed:
----- Method: Interpreter>>is:KindOfClass: (in category 'plugin primitive support') -----
is: oop KindOfClass: aClass
"Support for external primitives."
<api>
| oopClass |
oopClass := self fetchClassOf: oop.
+ [oopClass = objectMemory getNilObj] whileFalse:
- [oopClass = objectMemory nilObj] whileFalse:
[oopClass = aClass ifTrue: [^true].
oopClass := self superclassOf: oopClass].
^false!
Item was changed:
----- Method: Interpreter>>isEmptyList: (in category 'process primitive support') -----
isEmptyList: aLinkedList
+ ^ (objectMemory fetchPointer: FirstLinkIndex ofObject: aLinkedList) = objectMemory getNilObj!
- ^ (objectMemory fetchPointer: FirstLinkIndex ofObject: aLinkedList) = objectMemory nilObj!
Item was changed:
----- Method: Interpreter>>jumplfFalseBy: (in category 'jump bytecodes') -----
jumplfFalseBy: offset
| boolean |
boolean := self internalStackTop.
+ boolean = objectMemory getFalseObj
- boolean = objectMemory falseObj
ifTrue: [self jump: offset]
+ ifFalse: [boolean = objectMemory getTrueObj
- ifFalse: [boolean = objectMemory trueObj
ifFalse: [messageSelector := objectMemory splObj: SelectorMustBeBoolean.
argumentCount := 0.
^ self normalSend].
self fetchNextBytecode].
self internalPop: 1!
Item was changed:
----- Method: Interpreter>>jumplfTrueBy: (in category 'jump bytecodes') -----
jumplfTrueBy: offset
| boolean |
boolean := self internalStackTop.
+ boolean = objectMemory getTrueObj
- boolean = objectMemory trueObj
ifTrue: [self jump: offset]
+ ifFalse: [boolean = objectMemory getFalseObj
- ifFalse: [boolean = objectMemory falseObj
ifFalse: [messageSelector := objectMemory splObj: SelectorMustBeBoolean.
argumentCount := 0.
^ self normalSend].
self fetchNextBytecode].
self internalPop: 1!
Item was changed:
----- Method: Interpreter>>loadInitialContext (in category 'initialization') -----
loadInitialContext
| sched proc |
sched := objectMemory fetchPointer: ValueIndex ofObject: (objectMemory splObj: SchedulerAssociation).
proc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
activeContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: proc.
+ (objectMemory oop: activeContext isLessThan: objectMemory getYoungStart) ifTrue: [ objectMemory beRootIfOld: activeContext ].
- (objectMemory oop: activeContext isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: activeContext ].
self fetchContextRegisters: activeContext.
reclaimableContextCount := 0.!
Item was changed:
----- Method: Interpreter>>lookupMethodInClass: (in category 'message sending') -----
lookupMethodInClass: class
| currentClass dictionary found rclass |
<inline: false>
currentClass := class.
+ [currentClass ~= objectMemory getNilObj]
- [currentClass ~= objectMemory nilObj]
whileTrue:
[dictionary := objectMemory fetchPointer: MessageDictionaryIndex ofObject: currentClass.
+ dictionary = objectMemory getNilObj ifTrue:
- dictionary = objectMemory nilObj ifTrue:
["MethodDict pointer is nil (hopefully due a swapped out stub)
-- raise exception #cannotInterpret:."
objectMemory pushRemappableOop: currentClass. "may cause GC!!"
self createActualMessageTo: class.
currentClass := objectMemory popRemappableOop.
messageSelector := objectMemory splObj: SelectorCannotInterpret.
^ self lookupMethodInClass: (self superclassOf: currentClass)].
found := self lookupMethodInDictionary: dictionary.
found ifTrue: [^ methodClass := currentClass].
currentClass := self superclassOf: currentClass].
"Could not find #doesNotUnderstand: -- unrecoverable error."
messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue:
[self error: 'Recursive not understood error encountered'].
"Cound not find a normal message -- raise exception #doesNotUnderstand:"
objectMemory pushRemappableOop: class. "may cause GC!!"
self createActualMessageTo: class.
rclass := objectMemory popRemappableOop.
messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
^ self lookupMethodInClass: rclass!
Item was changed:
----- Method: Interpreter>>lookupMethodInDictionary: (in category 'message sending') -----
lookupMethodInDictionary: dictionary
"This method lookup tolerates integers as Dictionary keys to
support execution of images in which Symbols have been
compacted out"
| length index mask wrapAround nextSelector methodArray |
<inline: true>
length := objectMemory fetchWordLengthOf: dictionary.
mask := length - SelectorStart - 1.
(objectMemory isIntegerObject: messageSelector)
ifTrue: [index := (mask bitAnd: (objectMemory integerValueOf: messageSelector)) + SelectorStart]
ifFalse: [index := (mask bitAnd: (objectMemory hashBitsOf: messageSelector)) + SelectorStart].
"It is assumed that there are some nils in this dictionary, and search will
stop when one is encountered. However, if there are no nils, then wrapAround
will be detected the second time the loop gets to the end of the table."
wrapAround := false.
[true]
whileTrue: [nextSelector := objectMemory fetchPointer: index ofObject: dictionary.
+ nextSelector = objectMemory getNilObj ifTrue: [^ false].
- nextSelector = objectMemory nilObj ifTrue: [^ false].
nextSelector = messageSelector
ifTrue: [methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
newMethod := objectMemory fetchPointer: index - SelectorStart ofObject: methodArray.
"Check if newMethod is a CompiledMethod."
(objectMemory isCompiledMethod: newMethod)
ifTrue: [primitiveIndex := self primitiveIndexOf: newMethod.
primitiveIndex > MaxPrimitiveIndex
ifTrue: ["If primitiveIndex is out of range, set to zero before putting in
cache. This is equiv to primFail, and avoids the need to check on
every send."
primitiveIndex := 0]]
ifFalse: ["indicate that this is no compiled method - use primitiveInvokeObjectAsMethod"
primitiveIndex := 248].
^ true].
index := index + 1.
index = length
ifTrue: [wrapAround
ifTrue: [^ false].
wrapAround := true.
index := SelectorStart]]!
Item was changed:
----- Method: Interpreter>>lookupMethodNoMNUEtcInClass: (in category 'alien support') -----
lookupMethodNoMNUEtcInClass: class
"Lookup. Answer false on failure father than performing MNU processing etc."
| currentClass dictionary |
<inline: true>
currentClass := class.
+ [currentClass ~= objectMemory getNilObj] whileTrue:
- [currentClass ~= objectMemory nilObj] whileTrue:
[dictionary := objectMemory fetchPointer: MessageDictionaryIndex ofObject: currentClass.
+ (dictionary ~= objectMemory getNilObj
- (dictionary ~= objectMemory nilObj
and: [self lookupMethodInDictionary: dictionary]) ifTrue:
[methodClass := currentClass.
^true].
currentClass := self superclassOf: currentClass].
^false!
Item was changed:
----- Method: Interpreter>>mapInterpreterOops (in category 'object memory support') -----
mapInterpreterOops
"Map all oops in the interpreter's state to their new values
during garbage collection or a become: operation."
"Assume: All traced variables contain valid oops."
| oop |
objectMemory mapRootObjects.
compilerInitialized
ifFalse: [stackPointer := stackPointer - activeContext. "*rel to active"
activeContext := objectMemory remap: activeContext.
stackPointer := stackPointer + activeContext. "*rel to active"
theHomeContext := objectMemory remap: theHomeContext].
instructionPointer := instructionPointer - method. "*rel to method"
method := objectMemory remap: method.
instructionPointer := instructionPointer + method. "*rel to method"
receiver := objectMemory remap: receiver.
messageSelector := objectMemory remap: messageSelector.
newMethod := objectMemory remap: newMethod.
methodClass := objectMemory remap: methodClass.
lkupClass := objectMemory remap: lkupClass.
receiverClass := objectMemory remap: receiverClass.
+ 1 to: objectMemory getRemapBufferCount do: [:i |
+ oop := objectMemory remapBufferAt: i.
- 1 to: objectMemory remapBufferCount do: [:i |
- oop := objectMemory remapBuffer at: i.
(objectMemory isIntegerObject: oop)
+ ifFalse: [objectMemory remapBufferAt: i put: (objectMemory remap: oop)]].
- ifFalse: [objectMemory remapBuffer at: i put: (objectMemory remap: oop)]].
"Callback support - trace suspended callback list"
1 to: jmpDepth do:[:i|
oop := suspendedCallbacks at: i.
(objectMemory isIntegerObject: oop)
ifFalse:[suspendedCallbacks at: i put: (objectMemory remap: oop)].
oop := suspendedMethods at: i.
(objectMemory isIntegerObject: oop)
ifFalse:[suspendedMethods at: i put: (objectMemory remap: oop)].
].
!
Item was removed:
- ----- Method: Interpreter>>markAndTraceInterpreterOops (in category 'object memory support') -----
- markAndTraceInterpreterOops
- "Mark and trace all oops in the interpreter's state."
- "Assume: All traced variables contain valid oops."
- | oop |
- self compilerMarkHook.
- objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
- compilerInitialized
- ifTrue: [objectMemory markAndTrace: receiver.
- objectMemory markAndTrace: method]
- ifFalse: [objectMemory markAndTrace: activeContext].
- objectMemory markAndTrace: messageSelector.
- objectMemory markAndTrace: newMethod.
- objectMemory markAndTrace: methodClass.
- objectMemory markAndTrace: lkupClass.
- objectMemory markAndTrace: receiverClass.
- 1 to: objectMemory remapBufferCount do: [:i |
- oop := objectMemory remapBuffer at: i.
- (objectMemory isIntegerObject: oop) ifFalse: [objectMemory markAndTrace: oop]].
-
- "Callback support - trace suspended callback list"
- 1 to: jmpDepth do:[:i|
- oop := suspendedCallbacks at: i.
- (objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
- oop := suspendedMethods at: i.
- (objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
- ].
- !
Item was changed:
----- Method: Interpreter>>markAndTraceInterpreterOops: (in category 'object memory support') -----
markAndTraceInterpreterOops: fullGCFlag
+ "Mark and trace all oops in the interpreter's state."
+ "Assume: All traced variables contain valid oops."
+ | oop |
+ self compilerMarkHook.
+ objectMemory markAndTrace: objectMemory getSpecialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
+ compilerInitialized
+ ifTrue: [objectMemory markAndTrace: receiver.
+ objectMemory markAndTrace: method]
+ ifFalse: [objectMemory markAndTrace: activeContext].
+ objectMemory markAndTrace: messageSelector.
+ objectMemory markAndTrace: newMethod.
+ objectMemory markAndTrace: methodClass.
+ objectMemory markAndTrace: lkupClass.
+ objectMemory markAndTrace: receiverClass.
+ 1 to: objectMemory getRemapBufferCount do: [:i |
+ oop := objectMemory remapBufferAt: i.
+ (objectMemory isIntegerObject: oop) ifFalse: [objectMemory markAndTrace: oop]].
+
+ "Callback support - trace suspended callback list"
+ 1 to: jmpDepth do:[:i|
+ oop := suspendedCallbacks at: i.
+ (objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
+ oop := suspendedMethods at: i.
+ (objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
+ ].
- "Compatibility with NewObjectMemory"
- ^self markAndTraceInterpreterOops
!
Item was changed:
----- Method: Interpreter>>newActiveContext: (in category 'contexts') -----
newActiveContext: aContext
"Note: internalNewActiveContext: should track changes to this method."
self storeContextRegisters: activeContext.
+ (objectMemory oop: aContext isLessThan: objectMemory getYoungStart) ifTrue: [ objectMemory beRootIfOld: aContext ].
- (objectMemory oop: aContext isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: aContext ].
activeContext := aContext.
self fetchContextRegisters: aContext.!
Item was changed:
----- Method: Interpreter>>okayActiveProcessStack (in category 'debug support') -----
okayActiveProcessStack
| cntxt |
cntxt := activeContext.
+ [cntxt = objectMemory getNilObj] whileFalse: [
- [cntxt = objectMemory nilObj] whileFalse: [
self okayFields: cntxt.
cntxt := (objectMemory fetchPointer: SenderIndex ofObject: cntxt).
].!
Item was changed:
----- Method: Interpreter>>okayInterpreterObjects (in category 'debug support') -----
okayInterpreterObjects
| oopOrZero oop |
+ self okayFields: objectMemory getNilObj.
+ self okayFields: objectMemory getFalseObj.
+ self okayFields: objectMemory getTrueObj.
+ self okayFields: objectMemory getSpecialObjectsOop.
- self okayFields: objectMemory nilObj.
- self okayFields: objectMemory falseObj.
- self okayFields: objectMemory trueObj.
- self okayFields: objectMemory specialObjectsOop.
self okayFields: activeContext.
self okayFields: method.
self okayFields: receiver.
self okayFields: theHomeContext.
self okayFields: messageSelector.
self okayFields: newMethod.
self okayFields: lkupClass.
0 to: MethodCacheEntries - 1 by: MethodCacheEntrySize do: [ :i |
oopOrZero := methodCache at: i + MethodCacheSelector.
oopOrZero = 0 ifFalse: [
self okayFields: (methodCache at: i + MethodCacheSelector).
self okayFields: (methodCache at: i + MethodCacheClass).
self okayFields: (methodCache at: i + MethodCacheMethod).
].
].
+ 1 to: objectMemory getRemapBufferCount do: [ :i |
+ oop := objectMemory remapBufferAt: i.
- 1 to: objectMemory remapBufferCount do: [ :i |
- oop := objectMemory remapBuffer at: i.
(objectMemory isIntegerObject: oop) ifFalse: [
self okayFields: oop.
].
].
self okayActiveProcessStack.!
Item was changed:
----- Method: Interpreter>>pop:thenPushBool: (in category 'contexts') -----
pop: nItems thenPushBool: trueOrFalse
"A few places pop a few items off the stack and then push a boolean. Make it convenient"
| sp |
objectMemory longAt: (sp := stackPointer - ((nItems - 1) * objectMemory bytesPerWord))
+ put:(trueOrFalse ifTrue: [objectMemory getTrueObj] ifFalse: [objectMemory getFalseObj]).
- put:(trueOrFalse ifTrue: [objectMemory trueObj] ifFalse: [objectMemory falseObj]).
stackPointer := sp!
Item was changed:
----- Method: Interpreter>>postGCAction (in category 'object memory support') -----
postGCAction
"Mark the active and home contexts as roots if old. This
allows the interpreter to use storePointerUnchecked to
store into them."
compilerInitialized
ifTrue: [self compilerPostGC]
+ ifFalse: [(objectMemory oop: activeContext isLessThan: objectMemory getYoungStart)
- ifFalse: [(objectMemory oop: activeContext isLessThan: objectMemory youngStart)
ifTrue: [objectMemory beRootIfOld: activeContext].
+ (objectMemory oop: theHomeContext isLessThan: objectMemory getYoungStart)
- (objectMemory oop: theHomeContext isLessThan: objectMemory youngStart)
ifTrue: [objectMemory beRootIfOld: theHomeContext]].
+ (objectMemory oop: (objectMemory sizeOfFree: objectMemory getFreeBlock) isGreaterThan: objectMemory getShrinkThreshold)
- (objectMemory oop: (objectMemory sizeOfFree: objectMemory freeBlock) isGreaterThan: objectMemory shrinkThreshold)
ifTrue: ["Attempt to shrink memory after successfully
reclaiming lots of memory"
+ objectMemory shrinkObjectMemory: (objectMemory sizeOfFree: objectMemory getFreeBlock) - objectMemory getGrowHeadroom].
- objectMemory shrinkObjectMemory: (objectMemory sizeOfFree: objectMemory freeBlock) - objectMemory growHeadroom].
+ self signalSemaphoreWithIndex: objectMemory getGcSemaphoreIndex.
- self signalSemaphoreWithIndex: objectMemory gcSemaphoreIndex.
!
Item was changed:
----- Method: Interpreter>>primitiveBlockCopy (in category 'control primitives') -----
primitiveBlockCopy
| context methodContext contextSize newContext initialIP |
context := self stackValue: 1.
(objectMemory isIntegerObject: (objectMemory fetchPointer: MethodIndex ofObject: context))
ifTrue: ["context is a block; get the context of its enclosing method"
methodContext := objectMemory fetchPointer: HomeIndex ofObject: context]
ifFalse: [methodContext := context].
contextSize := objectMemory sizeBitsOf: methodContext. "in bytes, including header"
context := nil. "context is no longer needed and is not preserved across allocation"
"remap methodContext in case GC happens during allocation"
objectMemory pushRemappableOop: methodContext.
newContext := objectMemory instantiateContext: (objectMemory splObj: ClassBlockContext) sizeInBytes: contextSize.
methodContext := objectMemory popRemappableOop.
initialIP := objectMemory integerObjectOf: (instructionPointer+1+3) - (method + objectMemory baseHeaderSize).
"Was instructionPointer + 3, but now it's greater by 1 due to preIncrement"
"Assume: have just allocated a new context; it must be young.
Thus, can use uncheck stores. See the comment in fetchContextRegisters."
objectMemory storePointerUnchecked: InitialIPIndex ofObject: newContext withValue: initialIP.
objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: newContext withValue: initialIP.
self storeStackPointerValue: 0 inContext: newContext.
objectMemory storePointerUnchecked: BlockArgumentCountIndex ofObject: newContext withValue: (self stackValue: 0).
objectMemory storePointerUnchecked: HomeIndex ofObject: newContext withValue: methodContext.
+ objectMemory storePointerUnchecked: SenderIndex ofObject: newContext withValue: objectMemory getNilObj.
- objectMemory storePointerUnchecked: SenderIndex ofObject: newContext withValue: objectMemory nilObj.
self pop: 2 thenPush: newContext.!
Item was changed:
----- Method: Interpreter>>primitiveDeferDisplayUpdates (in category 'I/O primitives') -----
primitiveDeferDisplayUpdates
"Set or clear the flag that controls whether modifications of
the Display object are propagated to the underlying
platform's screen."
| flag |
flag := self stackTop.
+ flag = objectMemory getTrueObj
- flag = objectMemory trueObj
ifTrue: [deferDisplayUpdates := true]
+ ifFalse: [flag = objectMemory getFalseObj
- ifFalse: [flag = objectMemory falseObj
ifTrue: [deferDisplayUpdates := false]
ifFalse: [self primitiveFail]].
self successful
ifTrue: [self pop: 1]!
Item was changed:
----- Method: Interpreter>>primitiveDoPrimitiveWithArgs (in category 'control primitives') -----
primitiveDoPrimitiveWithArgs
| argumentArray arraySize index cntxSize primIdx |
argumentArray := self stackTop.
arraySize := objectMemory fetchWordLengthOf: argumentArray.
cntxSize := objectMemory fetchWordLengthOf: activeContext.
self success: self stackPointerIndex + arraySize < cntxSize.
(objectMemory isArray: argumentArray) ifFalse: [^ self primitiveFail].
primIdx := self stackIntegerValue: 1.
self successful ifFalse: [^ self primitiveFail]. "invalid args"
"Pop primIndex and argArray, then push args in place..."
self pop: 2.
primitiveIndex := primIdx.
argumentCount := arraySize.
index := 1.
[index <= argumentCount]
whileTrue: [self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
"Run the primitive (sets primFailCode)"
objectMemory pushRemappableOop: argumentArray. "prim might alloc/gc"
+ lkupClass := objectMemory getNilObj.
- lkupClass := objectMemory nilObj.
self primitiveResponse.
argumentArray := objectMemory popRemappableOop.
self successful
ifFalse: ["If primitive failed, then restore state for failure code"
self pop: arraySize.
self pushInteger: primIdx.
self push: argumentArray.
argumentCount := 2]!
Item was changed:
----- Method: Interpreter>>primitiveExternalCall (in category 'plugin primitives') -----
primitiveExternalCall
"Call an external primitive. The external primitive methods
contain as first literal an array consisting of:
* The module name (String | Symbol)
* The function name (String | Symbol)
* The session ID (SmallInteger) [OBSOLETE]
* The function index (Integer) in the externalPrimitiveTable
For fast failures the primitive index of any method where the
external prim is not found is rewritten in the method cache
with zero. This allows for ultra fast responses as long as the
method stays in the cache.
The fast failure response relies on lkupClass being properly
set. This is done in
#addToMethodCacheSel:class:method:primIndex: to
compensate for execution of methods that are looked up in a
superclass (such as in primitivePerformAt).
With the latest modifications (e.g., actually flushing the
function addresses from the VM), the session ID is obsolete.
But for backward compatibility it is still kept around. Also, a
failed lookup is reported specially. If a method has been
looked up and not been found, the function address is stored
as -1 (e.g., the SmallInteger -1 to distinguish from
16rFFFFFFFF which may be returned from the lookup).
It is absolutely okay to remove the rewrite if we run into any
problems later on. It has an approximate speed difference of
30% per failed primitive call which may be noticable but if,
for any reasons, we run into problems (like with J3) we can
always remove the rewrite.
"
| lit extFnAddr moduleName functionName moduleLength functionLength index |
<var: #extFnAddr declareC: 'void (*extFnAddr)(void)'>
"Fetch the first literal of the method"
self success: (self literalCountOf: newMethod) > 0. "@@: Could this be omitted for speed?!!"
self successful ifFalse: [^ nil].
lit := self literal: 0 ofMethod: newMethod.
"Check if it's an array of length 4"
self success: ((objectMemory isArray: lit) and: [(objectMemory lengthOf: lit) = 4]).
self successful ifFalse: [^ nil].
"Look at the function index in case it has been loaded before"
index := objectMemory fetchPointer: 3 ofObject: lit.
index := self checkedIntegerValueOf: index.
self successful ifFalse: [^ nil].
"Check if we have already looked up the function and failed."
index < 0
ifTrue: ["Function address was not found in this session,
Rewrite the mcache entry with a zero primitive index."
self
rewriteMethodCacheSel: messageSelector
class: lkupClass
primIndex: 0.
^ self success: false].
"Try to call the function directly"
(index > 0 and: [index <= MaxExternalPrimitiveTableSize])
ifTrue: [extFnAddr := externalPrimitiveTable at: index - 1.
extFnAddr ~= 0
ifTrue: [self rewriteMethodCacheSel: messageSelector class: lkupClass primIndex: (1000 + index) primFunction: extFnAddr.
self callExternalPrimitive: extFnAddr.
^ nil].
"if we get here, then an index to the external prim was
kept on the ST side although the underlying prim
table was already flushed"
^ self primitiveFail].
"Clean up session id and external primitive index"
objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero.
objectMemory storePointerUnchecked: 3 ofObject: lit withValue: ConstZero.
"The function has not been loaded yet. Fetch module and function name."
moduleName := objectMemory fetchPointer: 0 ofObject: lit.
+ moduleName = objectMemory getNilObj
- moduleName = objectMemory nilObj
ifTrue: [moduleLength := 0]
ifFalse: [self success: (objectMemory isBytes: moduleName).
moduleLength := objectMemory lengthOf: moduleName.
self cCode: '' inSmalltalk:
[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName))
ifTrue: [moduleLength := 0 "Cause all of these to fail"]]].
functionName := objectMemory fetchPointer: 1 ofObject: lit.
self success: (objectMemory isBytes: functionName).
functionLength := objectMemory lengthOf: functionName.
self successful ifFalse: [^ nil].
extFnAddr := self cCoerce: (self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
OfLength: functionLength
FromModule: moduleName + objectMemory baseHeaderSize
OfLength: moduleLength) to: 'void (*)(void)'.
extFnAddr = 0
ifTrue: [index := -1]
ifFalse: ["add the function to the external primitive table"
index := self addToExternalPrimitiveTable: extFnAddr].
self success: index >= 0.
"Store the index (or -1 if failure) back in the literal"
objectMemory storePointerUnchecked: 3 ofObject: lit withValue: (objectMemory integerObjectOf: index).
"If the function has been successfully loaded process it"
(self successful and: [extFnAddr ~= 0])
ifTrue: [self rewriteMethodCacheSel: messageSelector class: lkupClass primIndex: (1000 + index) primFunction: extFnAddr.
self callExternalPrimitive: extFnAddr]
ifFalse: ["Otherwise rewrite the primitive index"
self
rewriteMethodCacheSel: messageSelector
class: lkupClass
primIndex: 0]!
Item was changed:
----- Method: Interpreter>>primitivePerformInSuperclass (in category 'control primitives') -----
primitivePerformInSuperclass
| lookupClass rcvr currentClass |
lookupClass := self stackTop.
rcvr := self stackValue: 3.
currentClass := objectMemory fetchClassOf: rcvr.
[currentClass ~= lookupClass]
whileTrue:
[currentClass := self superclassOf: currentClass.
+ currentClass = objectMemory getNilObj ifTrue: [^self primitiveFailFor: PrimErrBadArgument]].
- currentClass = objectMemory nilObj ifTrue: [^self primitiveFailFor: PrimErrBadArgument]].
argumentCount = 3
ifTrue: ["normal primitive call with 3 arguments expected on the stack"
self popStack.
self primitivePerformAt: lookupClass.
self successful ifFalse:
[self push: lookupClass]]
ifFalse: [argumentCount = 4
ifTrue: ["mirror primitive call with extra argument specifying object to serve as receiver"
| s1 s2 s3 s4 s5 |
"save stack contents"
s1 := self popStack. "lookupClass"
s2 := self popStack. "args"
s3 := self popStack. "selector"
s4 := self popStack. "mirror receiver"
s5 := self popStack. "actual receiver"
"slide stack up one, omitting the actual receiver parameter"
self push: s4. "mirror receiver"
self push: s3. "selector"
self push: s2. "args"
"perform as if mirror receiver had been the actual receiver"
self primitivePerformAt: lookupClass.
self successful ifFalse:
["restore original stack"
self pop: 3. "args, selector, mirror receiver"
self push: s5. "actual receiver"
self push: s4. "mirror receiver"
self push: s3. "selector"
self push: s2. "args"
self push: s1. "lookup class" ]]
ifFalse: ["wrong number of arguments"
^self primitiveFailFor: PrimErrBadNumArgs]]
!
Item was changed:
----- Method: Interpreter>>primitivePushFalse (in category 'quick primitives') -----
primitivePushFalse
self popStack.
+ self push: objectMemory getFalseObj!
- self push: objectMemory falseObj!
Item was changed:
----- Method: Interpreter>>primitivePushNil (in category 'quick primitives') -----
primitivePushNil
self popStack.
+ self push: objectMemory getNilObj!
- self push: objectMemory nilObj!
Item was changed:
----- Method: Interpreter>>primitivePushTrue (in category 'quick primitives') -----
primitivePushTrue
self popStack.
+ self push: objectMemory getTrueObj!
- self push: objectMemory trueObj!
Item was changed:
----- Method: Interpreter>>primitiveSetGCSemaphore (in category 'memory space primitives') -----
primitiveSetGCSemaphore
"Primitive. Indicate the semaphore to be signalled for upon garbage collection"
| index |
<export: true>
index := self stackIntegerValue: 0.
self successful ifTrue:[
+ objectMemory setGcSemaphoreIndex: index.
- objectMemory gcSemaphoreIndex: index.
self pop: argumentCount.
].!
Item was changed:
----- Method: Interpreter>>primitiveSignalAtMilliseconds (in category 'system control primitives') -----
primitiveSignalAtMilliseconds
"Cause the time semaphore, if one has been registered, to
be signalled when the millisecond clock is greater than or
equal to the given tick value. A tick value of zero turns off
timer interrupts."
| tick sema |
tick := self popInteger.
sema := self popStack.
self successful
ifTrue: [(objectMemory fetchClassOf: sema) = (objectMemory splObj: ClassSemaphore)
ifTrue: [objectMemory
storePointer: TheTimerSemaphore
+ ofObject: objectMemory getSpecialObjectsOop
- ofObject: objectMemory specialObjectsOop
withValue: sema.
nextWakeupTick := tick]
ifFalse: [objectMemory
storePointer: TheTimerSemaphore
+ ofObject: objectMemory getSpecialObjectsOop
+ withValue: objectMemory getNilObj.
- ofObject: objectMemory specialObjectsOop
- withValue: objectMemory nilObj.
nextWakeupTick := 0]]
ifFalse: [self unPop: 2]!
Item was changed:
----- Method: Interpreter>>primitiveStoreStackp (in category 'object access primitives') -----
primitiveStoreStackp
"Atomic store into context stackPointer.
Also ensures that any newly accessible cells are initialized to nil "
| ctxt newStackp stackp |
ctxt := self stackValue: 1.
newStackp := self stackIntegerValue: 0.
self success: (objectMemory oop: newStackp isGreaterThanOrEqualTo: 0).
self success: (objectMemory oop: newStackp isLessThanOrEqualTo: (objectMemory largeContextSize - objectMemory baseHeaderSize // objectMemory bytesPerWord - CtxtTempFrameStart)).
self successful ifFalse: [^ self primitiveFail].
stackp := self fetchStackPointerOf: ctxt.
(objectMemory oop: newStackp isGreaterThan: stackp) ifTrue: ["Nil any newly accessible cells"
+ stackp + 1 to: newStackp do: [:i | objectMemory storePointer: i + CtxtTempFrameStart - 1 ofObject: ctxt withValue: objectMemory getNilObj]].
- stackp + 1 to: newStackp do: [:i | objectMemory storePointer: i + CtxtTempFrameStart - 1 ofObject: ctxt withValue: objectMemory nilObj]].
self storeStackPointerValue: newStackp inContext: ctxt.
self pop: 1!
Item was changed:
----- Method: Interpreter>>primitiveTerminateTo (in category 'process primitives') -----
primitiveTerminateTo
"Primitive. Terminate up the context stack from the receiver up to but not including the argument, if previousContext is on my Context stack. Make previousContext my sender. This prim has to shadow the code in ContextPart>terminateTo: to be correct"
| thisCntx currentCntx aContext nextCntx nilOop |
aContext := self popStack.
thisCntx := self popStack.
"make sure that aContext is in my chain"
(self context: thisCntx hasSender: aContext) ifTrue:[
+ nilOop := objectMemory getNilObj.
- nilOop := objectMemory nilObj.
currentCntx := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
[currentCntx = aContext] whileFalse: [
nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCntx.
objectMemory storePointer: SenderIndex ofObject: currentCntx withValue: nilOop.
objectMemory storePointer: InstructionPointerIndex ofObject: currentCntx withValue: nilOop.
currentCntx := nextCntx]].
objectMemory storePointer: SenderIndex ofObject: thisCntx withValue: aContext.
^self push: thisCntx!
Item was changed:
----- Method: Interpreter>>primitiveVMParameter (in category 'system control primitives') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: Interpreter>>primitiveValue (in category 'control primitives') -----
primitiveValue
| blockContext blockArgumentCount initialIP |
blockContext := self stackValue: argumentCount.
blockArgumentCount := self argumentCountOfBlock: blockContext.
self success: (argumentCount = blockArgumentCount
+ and: [(objectMemory fetchPointer: CallerIndex ofObject: blockContext) = objectMemory getNilObj]).
- and: [(objectMemory fetchPointer: CallerIndex ofObject: blockContext) = objectMemory nilObj]).
self successful
ifTrue: [self transfer: argumentCount
fromIndex: self stackPointerIndex - argumentCount + 1
ofObject: activeContext
toIndex: TempFrameStart
ofObject: blockContext.
"Assume: The call to transfer:... makes blockContext a root if necessary,
allowing use to use unchecked stored in the following code."
self pop: argumentCount + 1.
initialIP := objectMemory fetchPointer: InitialIPIndex ofObject: blockContext.
objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: blockContext withValue: initialIP.
self storeStackPointerValue: argumentCount inContext: blockContext.
objectMemory storePointerUnchecked: CallerIndex ofObject: blockContext withValue: activeContext.
self newActiveContext: blockContext]!
Item was changed:
----- Method: Interpreter>>primitiveValueWithArgs (in category 'control primitives') -----
primitiveValueWithArgs
| argumentArray blockContext blockArgumentCount arrayArgumentCount initialIP |
argumentArray := self popStack.
blockContext := self popStack.
blockArgumentCount := self argumentCountOfBlock: blockContext.
"If the argArray isnt actually an Array we ahve to unpop the above two"
(objectMemory isArray: argumentArray) ifFalse: [self unPop:2. ^self primitiveFail].
self successful ifTrue: [arrayArgumentCount := objectMemory fetchWordLengthOf: argumentArray.
self success: (arrayArgumentCount = blockArgumentCount
+ and: [(objectMemory fetchPointer: CallerIndex ofObject: blockContext) = objectMemory getNilObj])].
- and: [(objectMemory fetchPointer: CallerIndex ofObject: blockContext) = objectMemory nilObj])].
self successful
ifTrue: [self
transfer: arrayArgumentCount
fromIndex: 0
ofObject: argumentArray
toIndex: TempFrameStart
ofObject: blockContext.
"Assume: The call to transfer:... makes blockContext a root if necessary,
allowing use to use unchecked stored in the following code. "
initialIP := objectMemory fetchPointer: InitialIPIndex ofObject: blockContext.
objectMemory
storePointerUnchecked: InstructionPointerIndex
ofObject: blockContext
withValue: initialIP.
self storeStackPointerValue: arrayArgumentCount inContext: blockContext.
objectMemory
storePointerUnchecked: CallerIndex
ofObject: blockContext
withValue: activeContext.
self newActiveContext: blockContext]
ifFalse: [self unPop: 2]!
Item was changed:
----- Method: Interpreter>>printAllStacks (in category 'debug printing') -----
printAllStacks
"Print all the stacks of all running processes, including those that are currently suspended."
| oop proc ctx |
<export: true> "exported to permit access from plugins"
proc := objectMemory fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer.
self printNameOfClass: (objectMemory fetchClassOf: proc) count: 5.
self cr.
self printCallStackOf: activeContext. "first the active context"
oop := objectMemory firstObject.
+ [objectMemory oop: oop isLessThan: objectMemory getEndOfMemory] whileTrue:[
- [objectMemory oop: oop isLessThan: objectMemory endOfMemory] whileTrue:[
(objectMemory fetchClassOf: oop) == objectMemory classSemaphore ifTrue:[
self cr.
proc := objectMemory fetchPointer: FirstLinkIndex ofObject: oop.
[proc == objectMemory nilObject] whileFalse:[
self printNameOfClass: (objectMemory fetchClassOf: proc) count: 5.
self cr.
ctx := objectMemory fetchPointer: SuspendedContextIndex ofObject: proc.
ctx == objectMemory nilObject ifFalse:[self printCallStackOf: ctx].
proc := objectMemory fetchPointer: NextLinkIndex ofObject: proc].
].
oop := objectMemory objectAfter: oop.
].!
Item was changed:
----- Method: Interpreter>>printCallStackOf: (in category 'debug printing') -----
printCallStackOf: aContext
| ctxt home methClass methodSel message |
<inline: false>
ctxt := aContext.
+ [ctxt = objectMemory getNilObj] whileFalse: [
- [ctxt = objectMemory nilObj] whileFalse: [
(objectMemory fetchClassOf: ctxt) = (objectMemory splObj: ClassBlockContext)
ifTrue: [ home := objectMemory fetchPointer: HomeIndex ofObject: ctxt ]
ifFalse: [ home := ctxt ].
methClass :=
self findClassOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: home)
forReceiver: (objectMemory fetchPointer: ReceiverIndex ofObject: home).
methodSel :=
self findSelectorOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: home)
forReceiver: (objectMemory fetchPointer: ReceiverIndex ofObject: home).
self printNum: ctxt.
self print: ' '.
ctxt = home ifFalse: [ self print: '[] in ' ].
self printNameOfClass: methClass count: 5.
self print: '>'.
+ methodSel = objectMemory getNilObj
- methodSel = objectMemory nilObj
ifTrue: [self print: '?']
ifFalse: [self printStringOf: methodSel].
methodSel = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue: [
"print arg message selector"
message := objectMemory fetchPointer: 0 + TempFrameStart ofObject: home.
methodSel := objectMemory fetchPointer: MessageSelectorIndex ofObject: message.
self print: ' '.
self printStringOf: methodSel.
].
self cr.
ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt).
].!
Item was changed:
----- Method: Interpreter>>pushBool: (in category 'contexts') -----
pushBool: trueOrFalse
trueOrFalse
+ ifTrue: [ self push: objectMemory getTrueObj ]
+ ifFalse: [ self push: objectMemory getFalseObj ].!
- ifTrue: [ self push: objectMemory trueObj ]
- ifFalse: [ self push: objectMemory falseObj ].!
Item was changed:
----- Method: Interpreter>>pushConstantFalseBytecode (in category 'stack bytecodes') -----
pushConstantFalseBytecode
self fetchNextBytecode.
+ self internalPush: objectMemory getFalseObj.
- self internalPush: objectMemory falseObj.
!
Item was changed:
----- Method: Interpreter>>pushConstantNilBytecode (in category 'stack bytecodes') -----
pushConstantNilBytecode
self fetchNextBytecode.
+ self internalPush: objectMemory getNilObj.
- self internalPush: objectMemory nilObj.
!
Item was changed:
----- Method: Interpreter>>pushConstantTrueBytecode (in category 'stack bytecodes') -----
pushConstantTrueBytecode
self fetchNextBytecode.
+ self internalPush: objectMemory getTrueObj.
- self internalPush: objectMemory trueObj.
!
Item was changed:
----- Method: Interpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize |
<var: #f type: 'sqImageFile '>
<var: #desiredHeapSize type: 'usqInt'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #dataSize type: 'size_t '>
<var: #imageOffset type: 'squeakFileOffsetType '>
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - objectMemory bytesPerWord. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
+ objectMemory setSpecialObjectsOop: (self getLongFromFile: f swap: swapBytes).
+ objectMemory setLastHash: (self getLongFromFile: f swap: swapBytes).
- objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
- objectMemory lastHash: (self getLongFromFile: f swap: swapBytes).
savedWindowSize := self getLongFromFile: f swap: swapBytes.
fullScreenFlag := self oldFormatFullScreenFlag: (self getLongFromFile: f swap: swapBytes).
extraVMMemory := self getLongFromFile: f swap: swapBytes.
+ objectMemory getLastHash = 0 ifTrue: [
- objectMemory lastHash = 0 ifTrue: [
"lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
+ objectMemory setLastHash: 999].
- objectMemory lastHash: 999].
"decrease Squeak object heap to leave extra memory for the VM"
heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
"compare memory requirements with availability".
minimumMemory := dataSize + 100000. "need at least 100K of breathing room"
heapSize < minimumMemory ifTrue: [
self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap"
(objectMemory allocateMemory: heapSize
minimum: minimumMemory
imageFile: f
headerSize: headerSize) = nil ifTrue: [self insufficientMemoryAvailableError].
memStart := objectMemory startOfMemory.
+ objectMemory setMemoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety"
+ objectMemory setEndOfMemory: memStart + dataSize.
- objectMemory memoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety"
- objectMemory endOfMemory: memStart + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
bytesRead := self
+ sqImage: (objectMemory pointerForOop: objectMemory getMemory)
- sqImage: (objectMemory pointerForOop: objectMemory memory)
read: f
size: (self cCode: 'sizeof(unsigned char)')
length: dataSize.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
+ objectMemory headerTypeBytesAt: 0 put: objectMemory bytesPerWord * 2. "3-word header (type 0)"
+ objectMemory headerTypeBytesAt: 1 put: objectMemory bytesPerWord. "2-word header (type 1)"
+ objectMemory headerTypeBytesAt: 2 put: 0. "free chunk (type 2)"
+ objectMemory headerTypeBytesAt: 3 put: 0. "1-word header (type 3)"
- objectMemory headerTypeBytes at: 0 put: objectMemory bytesPerWord * 2. "3-word header (type 0)"
- objectMemory headerTypeBytes at: 1 put: objectMemory bytesPerWord. "2-word header (type 1)"
- objectMemory headerTypeBytes at: 2 put: 0. "free chunk (type 2)"
- objectMemory headerTypeBytes at: 3 put: 0. "1-word header (type 3)"
swapBytes ifTrue: [self reverseBytesInImage].
"compute difference between old and new memory base addresses"
bytesToShift := memStart - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
self isBigEnder. "work out the machine endianness and cache the answer"
+ (self initialImageFormatVersion bitAnd: 1) = 1
- (self imageFormatInitialVersion bitAnd: 1) = 1
ifTrue: ["Low order bit set, indicating that the image was saved from
a StackInterpreter (Cog) VM. Storage of all Float objects must be
returned to older object memory format."
self normalizeFloatOrderingInImage].
^ dataSize
!
Item was changed:
----- Method: Interpreter>>removeFirstLinkOfList: (in category 'process primitive support') -----
removeFirstLinkOfList: aList
"Remove the first process from the given linked list."
| first last next |
first := objectMemory fetchPointer: FirstLinkIndex ofObject: aList.
last := objectMemory fetchPointer: LastLinkIndex ofObject: aList.
first = last
+ ifTrue: [objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: objectMemory getNilObj.
+ objectMemory storePointer: LastLinkIndex ofObject: aList withValue: objectMemory getNilObj]
- ifTrue: [objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: objectMemory nilObj.
- objectMemory storePointer: LastLinkIndex ofObject: aList withValue: objectMemory nilObj]
ifFalse: [next := objectMemory fetchPointer: NextLinkIndex ofObject: first.
objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: next].
+ objectMemory storePointer: NextLinkIndex ofObject: first withValue: objectMemory getNilObj.
- objectMemory storePointer: NextLinkIndex ofObject: first withValue: objectMemory nilObj.
^ first!
Item was changed:
----- Method: Interpreter>>returnFalse (in category 'return bytecodes') -----
returnFalse
localReturnContext := self sender.
+ localReturnValue := objectMemory getFalseObj.
- localReturnValue := objectMemory falseObj.
self commonReturn.
!
Item was changed:
----- Method: Interpreter>>returnNil (in category 'return bytecodes') -----
returnNil
localReturnContext := self sender.
+ localReturnValue := objectMemory getNilObj.
- localReturnValue := objectMemory nilObj.
self commonReturn.!
Item was changed:
----- Method: Interpreter>>returnTrue (in category 'return bytecodes') -----
returnTrue
localReturnContext := self sender.
+ localReturnValue := objectMemory getTrueObj.
- localReturnValue := objectMemory trueObj.
self commonReturn.!
Item was changed:
----- Method: Interpreter>>reverseBytesInImage (in category 'image save/restore') -----
reverseBytesInImage
"Byte-swap all words in memory after reading in the entire image file with bulk read. Contributed by Tim Rowledge."
"First, byte-swap every word in the image. This fixes objects headers."
+ objectMemory reverseBytesFrom: objectMemory startOfMemory to: objectMemory getEndOfMemory.
- objectMemory reverseBytesFrom: objectMemory startOfMemory to: objectMemory endOfMemory.
"Second, return the bytes of bytes-type objects to their orginal order."
self byteSwapByteObjects.!
Item was changed:
----- Method: Interpreter>>saveProcessSignalingLowSpace (in category 'process primitive support') -----
saveProcessSignalingLowSpace
"The low space semaphore is about to be signaled. Save the currently active
process in the special objects array so that the low space handler will be able
to determine the process that first triggered a low space condition. The low
space handler (in the image) is expected to nil out the special objects array
slot when it handles the low space condition."
| lastSavedProcess sched currentProc |
lastSavedProcess := objectMemory splObj: ProcessSignalingLowSpace.
(lastSavedProcess == objectMemory nilObject) ifTrue:
[sched := self schedulerPointer.
currentProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
+ objectMemory storePointer: ProcessSignalingLowSpace ofObject: objectMemory getSpecialObjectsOop withValue: currentProc]!
- objectMemory storePointer: ProcessSignalingLowSpace ofObject: objectMemory specialObjectsOop withValue: currentProc]!
Item was changed:
----- Method: Interpreter>>sender (in category 'contexts') -----
sender
| context closureOrNil |
context := localHomeContext.
+ [(closureOrNil := objectMemory fetchPointer: ClosureIndex ofObject: context) ~~ objectMemory getNilObj] whileTrue:
- [(closureOrNil := objectMemory fetchPointer: ClosureIndex ofObject: context) ~~ objectMemory nilObj] whileTrue:
[context := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closureOrNil].
^objectMemory fetchPointer: SenderIndex ofObject: context!
Item was changed:
----- Method: Interpreter>>snapshot: (in category 'image save/restore') -----
snapshot: embedded
"update state of active context"
| activeProc dataSize rcvr setMacType |
<var: #setMacType type: 'void *'>
compilerInitialized
ifTrue: [self compilerPreSnapshot]
ifFalse: [self storeContextRegisters: activeContext].
"update state of active process"
activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer.
objectMemory
storePointer: SuspendedContextIndex
ofObject: activeProc
withValue: activeContext.
"compact memory and compute the size of the memory actually in use"
objectMemory incrementalGC.
"maximimize space for forwarding table"
objectMemory fullGC.
self snapshotCleanUp.
+ dataSize := objectMemory getFreeBlock - objectMemory startOfMemory. "Assume all objects are below the start of the free block"
- dataSize := objectMemory freeBlock - objectMemory startOfMemory. "Assume all objects are below the start of the free block"
self successful
ifTrue: [rcvr := self popStack.
"pop rcvr"
+ self push: objectMemory getTrueObj.
- self push: objectMemory trueObj.
self writeImageFile: dataSize.
embedded
ifFalse: ["set Mac file type and creator; this is a noop on other platforms"
setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'.
setMacType = 0
ifFalse: [self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']].
self pop: 1].
"activeContext was unmarked in #snapshotCleanUp, mark it old "
objectMemory beRootIfOld: activeContext.
self successful
+ ifTrue: [self push: objectMemory getFalseObj]
- ifTrue: [self push: objectMemory falseObj]
ifFalse: [self push: rcvr].
compilerInitialized
ifTrue: [self compilerPostSnapshot]!
Item was changed:
----- Method: Interpreter>>snapshotCleanUp (in category 'image save/restore') -----
snapshotCleanUp
"Clean up right before saving an image, sweeping memory and:
* nilling out all fields of contexts above the stack pointer.
* flushing external primitives
* clearing the root bit of any object in the root table "
| oop header fmt sz |
oop := objectMemory firstObject.
+ [objectMemory oop: oop isLessThan: objectMemory getEndOfMemory]
- [objectMemory oop: oop isLessThan: objectMemory endOfMemory]
whileTrue: [(objectMemory isFreeObject: oop)
ifFalse: [header := objectMemory longAt: oop.
fmt := header >> 8 bitAnd: 15.
"Clean out context"
(fmt = 3 and: [self isContextHeader: header])
ifTrue: [sz := objectMemory sizeBitsOf: oop.
(objectMemory lastPointerOf: oop) + objectMemory bytesPerWord
to: sz - objectMemory baseHeaderSize by: objectMemory bytesPerWord
+ do: [:i | objectMemory longAt: oop + i put: objectMemory getNilObj]].
- do: [:i | objectMemory longAt: oop + i put: objectMemory nilObj]].
"Clean out external functions"
fmt >= 12
ifTrue: ["This is a compiled method"
(self primitiveIndexOf: oop) = PrimitiveExternalCallIndex
ifTrue: ["It's primitiveExternalCall"
self flushExternalPrimitiveOf: oop]]].
oop := objectMemory objectAfter: oop].
objectMemory clearRootsTable!
Item was changed:
----- Method: Interpreter>>storeAndPopReceiverVariableBytecode (in category 'stack bytecodes') -----
storeAndPopReceiverVariableBytecode
"Note: This code uses
storePointerUnchecked:ofObject:withValue: and does the
store check explicitely in order to help the translator
produce better code."
| rcvr top |
self flag: #'requires currentBytecode to be expanded to a constant'.
self fetchNextBytecode.
"this bytecode will be expanded so that refs to currentBytecode below will be constant"
rcvr := receiver.
top := self internalStackTop.
+ (objectMemory oop: rcvr isLessThan: objectMemory getYoungStart)
- (objectMemory oop: rcvr isLessThan: objectMemory youngStart)
ifTrue: [objectMemory possibleRootStoreInto: rcvr value: top].
objectMemory storePointerUnchecked: (currentBytecode bitAnd: 7) ofObject: rcvr withValue: top.
self internalPop: 1!
Item was changed:
----- Method: Interpreter>>transferTo: (in category 'process primitive support') -----
transferTo: aProc
"Record a process to be awoken on the next interpreter cycle.
ikp 11/24/1999 06:07 -- added hook for external runtime
compiler "
| sched oldProc newProc |
newProc := aProc.
sched := self schedulerPointer.
oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc.
compilerInitialized
ifTrue: [self compilerProcessChange: oldProc to: newProc]
ifFalse: [objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext.
self newActiveContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: newProc).
+ objectMemory storePointer: SuspendedContextIndex ofObject: newProc withValue: objectMemory getNilObj].
- objectMemory storePointer: SuspendedContextIndex ofObject: newProc withValue: objectMemory nilObj].
reclaimableContextCount := 0!
Item was changed:
----- Method: Interpreter>>writeImageFileIO: (in category 'image save/restore') -----
writeImageFileIO: imageBytes
| headerStart headerSize f bytesWritten sCWIfn okToWrite |
<var: #f type: 'sqImageFile'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #sCWIfn type: 'void *'>
"If the security plugin can be loaded, use it to check for write permission.
If not, assume it's ok"
sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
sCWIfn ~= 0 ifTrue:[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
okToWrite ifFalse:[^self primitiveFail]].
"local constants"
headerStart := 0.
headerSize := 16 * objectMemory bytesPerWord. "header size in bytes; do not change!!"
f := self cCode: 'sqImageFileOpen(imageName, "wb")'.
f = nil ifTrue: [
"could not open the image file for writing"
self success: false.
^ nil].
headerStart := self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+imageBytes)'.
self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
"position file to start of header"
self sqImageFile: f Seek: headerStart.
self putLong: (self imageFormatVersion) toFile: f.
self putLong: headerSize toFile: f.
self putLong: imageBytes toFile: f.
self putLong: (objectMemory startOfMemory) toFile: f.
+ self putLong: objectMemory getSpecialObjectsOop toFile: f.
+ self putLong: objectMemory getLastHash toFile: f.
- self putLong: objectMemory specialObjectsOop toFile: f.
- self putLong: objectMemory lastHash toFile: f.
self putLong: (self ioScreenSize) toFile: f.
self putLong: fullScreenFlag toFile: f.
self putLong: extraVMMemory toFile: f.
1 to: 7 do: [:i | self putLong: 0 toFile: f]. "fill remaining header words with zeros"
self successful ifFalse: [
"file write or seek failure"
self cCode: 'sqImageFileClose(f)'.
^ nil].
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"write the image data"
bytesWritten := self
+ sqImage: (objectMemory pointerForOop: objectMemory getMemory)
- sqImage: (objectMemory pointerForOop: objectMemory memory)
write: f
size: (self cCode: 'sizeof(unsigned char)')
length: imageBytes.
self success: bytesWritten = imageBytes.
self cCode: 'sqImageFileClose(f)'.
!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveBeDisplay (in category 'I/O primitives') -----
primitiveBeDisplay
"Record the system Display object in the specialObjectsTable."
| rcvr |
rcvr := self stackTop.
self success: ((objectMemory isPointers: rcvr) and: [(objectMemory lengthOf: rcvr) >= 4]).
+ self successful ifTrue: [objectMemory storePointer: TheDisplay ofObject: objectMemory getSpecialObjectsOop withValue: rcvr]!
- self successful ifTrue: [objectMemory storePointer: TheDisplay ofObject: objectMemory specialObjectsOop withValue: rcvr]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveBytesLeft (in category 'memory space primitives') -----
primitiveBytesLeft
"Reports bytes available at this moment. For more meaningful
results, calls to this primitive should be preceeded by a full
or incremental garbage collection."
| aBool |
self methodArgumentCount = 0
ifTrue: ["old behavior - just return the size of the free block"
+ ^self pop: 1 thenPush: (self positive64BitIntegerFor: (objectMemory sizeOfFree: objectMemory getFreeBlock))].
- ^self pop: 1 thenPush: (self positive64BitIntegerFor: (objectMemory sizeOfFree: objectMemory freeBlock))].
self methodArgumentCount = 1
ifTrue: ["new behaviour -including or excluding swap space depending on aBool"
aBool := self booleanValueOf: self stackTop.
self successful ifFalse: [^ nil].
^self pop: 2 thenPush: (self positive64BitIntegerFor: (objectMemory bytesLeft: aBool))].
^ self primitiveFail!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFailAfterCleanup: (in category 'image segment in/out') -----
primitiveFailAfterCleanup: outPointerArray
"If the storeSegment primitive fails, it must clean up first."
| i lastAddr | "Store nils throughout the outPointer array."
lastAddr := outPointerArray + (objectMemory lastPointerOf: outPointerArray).
i := outPointerArray + objectMemory baseHeaderSize.
[i <= lastAddr] whileTrue:
+ [objectMemory longAt: i put: objectMemory getNilObj.
- [objectMemory longAt: i put: objectMemory nilObj.
i := i + objectMemory bytesPerWord].
DoAssertionChecks ifTrue: [objectMemory verifyCleanHeaders].
self primitiveFail!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFindHandlerContext (in category 'control primitives') -----
primitiveFindHandlerContext
"Primitive. Search up the context stack for the next method context marked for exception handling starting at the receiver. Return nil if none found"
| thisCntx nilOop |
thisCntx := self popStack.
+ nilOop := objectMemory getNilObj.
- nilOop := objectMemory nilObj.
[(self isHandlerMarked: thisCntx) ifTrue:[
self push: thisCntx.
^nil].
thisCntx := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
thisCntx = nilOop] whileFalse.
+ ^self push: objectMemory getNilObj!
- ^self push: objectMemory nilObj!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFindNextUnwindContext (in category 'control primitives') -----
primitiveFindNextUnwindContext
"Primitive. Search up the context stack for the next method context marked for unwind handling from the receiver up to but not including the argument. Return nil if none found."
| thisCntx nilOop aContext unwindMarked |
aContext := self popStack.
thisCntx := objectMemory fetchPointer: SenderIndex ofObject: self popStack.
+ nilOop := objectMemory getNilObj.
- nilOop := objectMemory nilObj.
[(thisCntx = aContext) or: [thisCntx = nilOop]] whileFalse: [
unwindMarked := self isUnwindMarked: thisCntx.
unwindMarked ifTrue:[
self push: thisCntx.
^nil].
thisCntx := objectMemory fetchPointer: SenderIndex ofObject: thisCntx].
^self push: nilOop!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveForceTenure (in category 'I/O primitives') -----
primitiveForceTenure
"Set force tenure flag to true, this forces a tenure operation on the next incremental GC"
<export: true>
+ objectMemory setForceTenureFlag: 1!
- objectMemory forceTenureFlag: 1!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveInterruptSemaphore (in category 'I/O primitives') -----
primitiveInterruptSemaphore
"Register the user interrupt semaphore. If the argument is
not a Semaphore, unregister the current interrupt
semaphore. "
| arg |
arg := self popStack.
(objectMemory fetchClassOf: arg) = (objectMemory splObj: ClassSemaphore)
+ ifTrue: [objectMemory storePointer: TheInterruptSemaphore ofObject: objectMemory getSpecialObjectsOop withValue: arg]
+ ifFalse: [objectMemory storePointer: TheInterruptSemaphore ofObject: objectMemory getSpecialObjectsOop withValue: objectMemory getNilObj]!
- ifTrue: [objectMemory storePointer: TheInterruptSemaphore ofObject: objectMemory specialObjectsOop withValue: arg]
- ifFalse: [objectMemory storePointer: TheInterruptSemaphore ofObject: objectMemory specialObjectsOop withValue: objectMemory nilObj]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveIsYoung (in category 'memory space primitives') -----
primitiveIsYoung
"Primitive. Answer whether the argument to the primitive resides in young space."
| oop |
<export: true>
oop := self stackObjectValue: 0.
self successful ifTrue:[
self pop: argumentCount + 1.
+ self pushBool: (objectMemory oop: oop isGreaterThanOrEqualTo: objectMemory getYoungStart).
- self pushBool: (objectMemory oop: oop isGreaterThanOrEqualTo: objectMemory youngStart).
].!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveKbdNext (in category 'I/O primitives') -----
primitiveKbdNext
"Obsolete on virtually all platforms; old style input polling code.
Return the next keycode and remove it from the input buffer. The low byte is the 8-bit ISO character. The next four bits are the Smalltalk modifier bits <cmd><option><ctrl><shift>."
| keystrokeWord |
self pop: 1.
keystrokeWord := self ioGetKeystroke.
keystrokeWord >= 0
ifTrue: [self pushInteger: keystrokeWord]
+ ifFalse: [self push: objectMemory getNilObj].!
- ifFalse: [self push: objectMemory nilObj].!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveKbdPeek (in category 'I/O primitives') -----
primitiveKbdPeek
"Obsolete on virtually all platforms; old style input polling code.
Return the next keycode and without removing it from the input buffer. The low byte is the 8-bit ISO character. The next four bits are the Smalltalk modifier bits <cmd><option><ctrl><shift>."
| keystrokeWord |
self pop: 1.
keystrokeWord := self ioPeekKeystroke.
keystrokeWord >= 0
ifTrue: [self pushInteger: keystrokeWord]
+ ifFalse: [self push: objectMemory getNilObj].!
- ifFalse: [self push: objectMemory nilObj].!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveLoadImageSegment (in category 'image segment in/out') -----
primitiveLoadImageSegment
"This primitive is called from Squeak as...
<imageSegment> loadSegmentFrom: aWordArray outPointers: anArray."
"This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of zero. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you have done with it anyway?"
| outPointerArray segmentWordArray endSeg segOop fieldPtr fieldOop doingClass lastPtr extraSize mapOop lastOut outPtr hdrTypeBits header data |
<var: #endSeg type: 'usqInt'>
<var: #segOop type: 'usqInt'>
<var: #fieldPtr type: 'usqInt'>
<var: #lastOut type: 'usqInt'>
<var: #outPtr type: 'usqInt'>
<var: #lastPtr type: 'usqInt'>
DoAssertionChecks ifTrue: [objectMemory verifyCleanHeaders].
outPointerArray := self stackTop.
lastOut := outPointerArray + (objectMemory lastPointerOf: outPointerArray).
segmentWordArray := self stackValue: 1.
endSeg := segmentWordArray + (objectMemory sizeBitsOf: segmentWordArray) - objectMemory baseHeaderSize.
"Essential type checks"
((objectMemory formatOf: outPointerArray) = 2 "Must be indexable pointers"
and: [(objectMemory formatOf: segmentWordArray) = 6]) "Must be indexable words"
ifFalse: [^ self primitiveFail].
"Version check. Byte order of the WordArray now"
data := objectMemory longAt: segmentWordArray + objectMemory baseHeaderSize.
(self readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: [
"Not readable -- try again with reversed bytes..."
objectMemory reverseBytesFrom: segmentWordArray + objectMemory baseHeaderSize to: endSeg + objectMemory bytesPerWord.
data := objectMemory longAt: segmentWordArray + objectMemory baseHeaderSize.
(self readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: [
"Still NG -- put things back and fail"
objectMemory reverseBytesFrom: segmentWordArray + objectMemory baseHeaderSize to: endSeg + objectMemory bytesPerWord.
DoAssertionChecks ifTrue: [objectMemory verifyCleanHeaders].
^ self primitiveFail]].
"Reverse the Byte type objects if the is data from opposite endian machine."
"Test top byte. $d on the Mac or $s on the PC. Rest of word is equal."
(data >> 16) = (objectMemory imageSegmentVersion >> 16) ifFalse: [
"Reverse the byte-type objects once"
segOop := objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord.
"Oop of first embedded object"
self byteSwapByteObjectsFrom: segOop to: endSeg + objectMemory bytesPerWord].
"Proceed through the segment, remapping pointers..."
segOop := objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord.
[segOop <= endSeg] whileTrue:
[(objectMemory headerType: segOop) <= 1
ifTrue: ["This object has a class field (type = 0 or 1) -- start with that."
fieldPtr := segOop - objectMemory bytesPerWord. doingClass := true]
ifFalse: ["No class field -- start with first data field"
fieldPtr := segOop + objectMemory baseHeaderSize. doingClass := false].
lastPtr := segOop + (objectMemory lastPointerOf: segOop). "last field"
lastPtr > endSeg ifTrue: [
DoAssertionChecks ifTrue: [objectMemory verifyCleanHeaders].
^ self primitiveFail "out of bounds"].
"Go through all oops, remapping them..."
[fieldPtr > lastPtr] whileFalse:
["Examine each pointer field"
fieldOop := objectMemory longAt: fieldPtr.
doingClass ifTrue:
[hdrTypeBits := objectMemory headerType: fieldPtr.
fieldOop := fieldOop - hdrTypeBits].
(objectMemory isIntegerObject: fieldOop)
ifTrue:
["Integer -- nothing to do"
fieldPtr := fieldPtr + objectMemory bytesPerWord]
ifFalse:
[(fieldOop bitAnd: 3) = 0 ifFalse: [^ self primitiveFail "bad oop"].
(fieldOop bitAnd: 16r80000000) = 0
ifTrue: ["Internal pointer -- add segment offset"
mapOop := fieldOop + segmentWordArray]
ifFalse: ["External pointer -- look it up in outPointers"
outPtr := outPointerArray + (fieldOop bitAnd: 16r7FFFFFFF).
outPtr > lastOut ifTrue: [^ self primitiveFail "out of bounds"].
mapOop := objectMemory longAt: outPtr].
doingClass
ifTrue: [objectMemory longAt: fieldPtr put: mapOop + hdrTypeBits.
fieldPtr := fieldPtr + 8.
doingClass := false]
ifFalse: [objectMemory longAt: fieldPtr put: mapOop.
fieldPtr := fieldPtr + objectMemory bytesPerWord].
+ segOop < objectMemory getYoungStart
- segOop < objectMemory youngStart
ifTrue: [objectMemory possibleRootStoreInto: segOop value: mapOop].
]].
segOop := objectMemory objectAfter: segOop].
"Again, proceed through the segment checking consistency..."
segOop := objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord.
[segOop <= endSeg] whileTrue:
[(objectMemory oopHasAcceptableClass: segOop) ifFalse: [^ self primitiveFail "inconsistency"].
fieldPtr := segOop + objectMemory baseHeaderSize. "first field"
lastPtr := segOop + (objectMemory lastPointerOf: segOop). "last field"
"Go through all oops, remapping them..."
[fieldPtr > lastPtr] whileFalse:
["Examine each pointer field"
fieldOop := objectMemory longAt: fieldPtr.
(objectMemory oopHasAcceptableClass: fieldOop) ifFalse: [^ self primitiveFail "inconsistency"].
fieldPtr := fieldPtr + objectMemory bytesPerWord].
segOop := objectMemory objectAfter: segOop].
"Truncate the segment word array to size = objectMemory bytesPerWord (vers stamp only)"
extraSize := objectMemory extraHeaderBytes: segmentWordArray.
hdrTypeBits := objectMemory headerType: segmentWordArray.
extraSize = 8
ifTrue: [objectMemory longAt: segmentWordArray-extraSize put: objectMemory baseHeaderSize + objectMemory bytesPerWord + hdrTypeBits]
ifFalse: [header := objectMemory longAt: segmentWordArray.
objectMemory longAt: segmentWordArray
put: header - (header bitAnd: objectMemory sizeMask) + objectMemory baseHeaderSize + objectMemory bytesPerWord].
"and return the roots array which was first in the segment"
DoAssertionChecks ifTrue: [objectMemory verifyCleanHeaders].
self pop: 3 thenPush: (objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord).
!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveLowSpaceSemaphore (in category 'memory space primitives') -----
primitiveLowSpaceSemaphore
"Register the low-space semaphore. If the argument is not a
Semaphore, unregister the current low-space Semaphore."
| arg |
arg := self popStack.
(objectMemory fetchClassOf: arg) = (objectMemory splObj: ClassSemaphore)
+ ifTrue: [objectMemory storePointer: TheLowSpaceSemaphore ofObject: objectMemory getSpecialObjectsOop withValue: arg]
+ ifFalse: [objectMemory storePointer: TheLowSpaceSemaphore ofObject: objectMemory getSpecialObjectsOop withValue: objectMemory getNilObj]!
- ifTrue: [objectMemory storePointer: TheLowSpaceSemaphore ofObject: objectMemory specialObjectsOop withValue: arg]
- ifFalse: [objectMemory storePointer: TheLowSpaceSemaphore ofObject: objectMemory specialObjectsOop withValue: objectMemory nilObj]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveNewMethod (in category 'compiled methods') -----
primitiveNewMethod
| header bytecodeCount class size theMethod literalCount |
header := self popStack.
bytecodeCount := self popInteger.
self success: (objectMemory isIntegerObject: header).
self successful ifFalse:
[self unPop: 2. ^nil].
class := self popStack.
size := (self literalCountOfHeader: header) + 1 * objectMemory bytesPerWord + bytecodeCount.
theMethod := objectMemory instantiateClass: class indexableSize: size.
objectMemory storePointerUnchecked: HeaderIndex ofObject: theMethod withValue: header.
literalCount := self literalCountOfHeader: header.
1 to: literalCount do:
+ [:i | objectMemory storePointer: i ofObject: theMethod withValue: objectMemory getNilObj].
- [:i | objectMemory storePointer: i ofObject: theMethod withValue: objectMemory nilObj].
self push: theMethod!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveNextInstance (in category 'object access primitives') -----
primitiveNextInstance
| object instance |
object := self stackTop.
instance := objectMemory instanceAfter: object.
+ instance = objectMemory getNilObj
- instance = objectMemory nilObj
ifTrue: [self primitiveFail]
ifFalse: [self pop: argumentCount+1 thenPush: instance]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveRootTable (in category 'memory space primitives') -----
primitiveRootTable
"Primitive. Answer a copy (snapshot) element of the root table.
The primitive can cause GC itself and if so the return value may
be inaccurate - in this case one should guard the read operation
by looking at the gc counter statistics."
| oop sz |
<export: true>
+ sz := objectMemory getRootTableCount.
- sz := objectMemory rootTableCount.
oop := objectMemory instantiateClass: objectMemory classArray indexableSize: sz. "can cause GC"
+ sz > objectMemory getRootTableCount ifTrue:[sz := objectMemory getRootTableCount].
- sz > objectMemory rootTableCount ifTrue:[sz := objectMemory rootTableCount].
1 to: sz do:[:i|
+ objectMemory storePointer: i-1 ofObject: oop withValue: (objectMemory rootTableAt: i).
- objectMemory storePointer: i-1 ofObject: oop withValue: (objectMemory rootTable at: i).
].
self pop: argumentCount + 1.
self push: oop.!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveRootTableAt (in category 'memory space primitives') -----
primitiveRootTableAt
"Primitive. Answer the nth element of the root table.
This primitive avoids the creation of an extra array;
it is intended for enumerations of the form:
index := 1.
[root := Smalltalk rootTableAt: index.
root == nil] whileFalse:[index := index + 1].
"
| index |
<export: true>
index := self stackIntegerValue: 0.
+ self success: (index > 0 and:[index <= objectMemory getRootTableCount]).
- self success: (index > 0 and:[index <= objectMemory rootTableCount]).
self successful ifTrue:[
self pop: argumentCount + 1.
+ self push: (objectMemory rootTableAt: index).
- self push: (objectMemory rootTable at: index).
].!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSetFullScreen (in category 'I/O primitives') -----
primitiveSetFullScreen
"On platforms that support it, set full-screen mode to the value of the boolean argument."
| argOop |
argOop := self stackTop.
+ argOop = objectMemory getTrueObj
- argOop = objectMemory trueObj
ifTrue: [self ioSetFullScreen: true]
+ ifFalse: [ argOop = objectMemory getFalseObj
- ifFalse: [ argOop = objectMemory falseObj
ifTrue: [self ioSetFullScreen: false]
ifFalse: [self primitiveFail]].
self successful ifTrue: [self pop: 1].
!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSetGCBiasToGrow (in category 'memory space primitives') -----
primitiveSetGCBiasToGrow
"Primitive. Indicate if the GC logic should have bias to grow"
| flag |
<export: true>
flag := self stackIntegerValue: 0.
self successful ifTrue:[
+ objectMemory setGcBiasToGrow: flag.
- objectMemory gcBiasToGrow: flag.
self pop: argumentCount.
].!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSignalAtBytesLeft (in category 'memory space primitives') -----
primitiveSignalAtBytesLeft
"Set the low-water mark for free space. When the free space
falls below this level, the new and new: primitives fail and
system attempts to allocate space (e.g., to create a method
context) cause the low-space semaphore (if one is
registered) to be signalled."
| bytes |
bytes := self popInteger.
self successful
+ ifTrue: [objectMemory setLowSpaceThreshold: bytes]
+ ifFalse: [objectMemory setLowSpaceThreshold: 0.
- ifTrue: [objectMemory lowSpaceThreshold: bytes]
- ifFalse: [objectMemory lowSpaceThreshold: 0.
self unPop: 1]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSomeInstance (in category 'object access primitives') -----
primitiveSomeInstance
| class instance |
class := self stackTop.
instance := objectMemory initialInstanceOf: class.
+ instance = objectMemory getNilObj
- instance = objectMemory nilObj
ifTrue: [self primitiveFail]
ifFalse: [self pop: argumentCount+1 thenPush: instance]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSpecialObjectsOop (in category 'system control primitives') -----
primitiveSpecialObjectsOop
"Return the oop of the SpecialObjectsArray."
+ self pop: 1 thenPush: objectMemory getSpecialObjectsOop.!
- self pop: 1 thenPush: objectMemory specialObjectsOop.!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveStoreImageSegment (in category 'image segment in/out') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSuspend (in category 'process primitives') -----
primitiveSuspend
"Primitive. Suspend the receiver, aProcess such that it can be executed again
by sending #resume. If the given process is not currently running, take it off
its corresponding list. The primitive returns the list the receiver was previously on."
| process activeProc myList |
process := self stackTop.
activeProc := objectMemory fetchPointer: ActiveProcessIndex
ofObject: self schedulerPointer.
process == activeProc ifTrue:[
self pop: 1.
+ self push: objectMemory getNilObj.
- self push: objectMemory nilObj.
self transferTo: self wakeHighestPriority.
] ifFalse:[
myList := objectMemory fetchPointer: MyListIndex ofObject: process.
"XXXX Fixme. We should really check whether myList is a kind of LinkedList or not
but we can't easily so just do a quick check for nil which is the most common case."
+ myList == objectMemory getNilObj ifTrue:[^self primitiveFail].
- myList == objectMemory nilObject ifTrue:[^self primitiveFail].
self removeProcess: process fromList: myList.
self successful ifTrue:[
+ objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory getNilObj.
- objectMemory storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject.
self pop: 1.
self push: myList.
].
].
!
Item was changed:
----- Method: InterpreterSimulator class>>on: (in category 'instance creation') -----
on: objectMemory
| interp |
interp := self == InterpreterSimulator
ifTrue: [SmalltalkImage current endianness == #big
ifTrue: [InterpreterSimulatorMSB basicNew]
ifFalse: [InterpreterSimulatorLSB basicNew]]
ifFalse: [super basicNew].
interp objectMemory: objectMemory.
+ objectMemory setInterpreter: interp.
- objectMemory interpreter: interp.
^ interp initialize
!
Item was changed:
----- Method: InterpreterSimulator>>classAndSelectorOfMethod:forReceiver: (in category 'debug support') -----
classAndSelectorOfMethod: meth forReceiver: rcvr
| mClass dict length methodArray |
mClass := objectMemory fetchClassOf: rcvr.
[dict := objectMemory fetchPointer: MessageDictionaryIndex ofObject: mClass.
length := objectMemory fetchWordLengthOf: dict.
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dict.
0 to: length-SelectorStart-1 do:
[:index |
meth = (objectMemory fetchPointer: index ofObject: methodArray)
ifTrue: [^ Array
with: mClass
with: (objectMemory fetchPointer: index + SelectorStart ofObject: dict)]].
mClass := objectMemory fetchPointer: SuperclassIndex ofObject: mClass.
+ mClass = objectMemory getNilObj]
- mClass = objectMemory nilObj]
whileFalse: [].
^ Array
with: (objectMemory fetchClassOf: rcvr)
with: (objectMemory splObj: SelectorDoesNotUnderstand)!
Item was changed:
----- Method: InterpreterSimulator>>compactClassAt: (in category 'debug support') -----
compactClassAt: ccIndex
"Index must be between 1 and compactClassArray size. (A zero compact class index in the base header indicate that the class is in the class header word.)"
| classArray |
+ classArray := objectMemory fetchPointer: CompactClasses ofObject: objectMemory getSpecialObjectsOop.
- classArray := objectMemory fetchPointer: CompactClasses ofObject: objectMemory specialObjectsOop.
^ objectMemory fetchPointer: (ccIndex - 1) ofObject: classArray!
Item was changed:
----- Method: InterpreterSimulator>>convertToArray (in category 'initialization') -----
convertToArray
"I dont believe it -- this *just works*"
"The comment above is from the original method, stamped di 5/8/2004 16:42"
+ objectMemory setMemory: (objectMemory getMemory as: Array)!
- objectMemory memory: (objectMemory memory as: Array)!
Item was changed:
----- Method: InterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the InterpreterSimulator when running the interpreter inside
Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
"copy of bytesPerWord to avoid extra indirection that may affect performance"
bytesPerWord := objectMemory bytesPerWord.
"initialize class variables"
ObjectMemory initializeConstants.
Interpreter initialize.
"Note: we must initialize ConstMinusOne differently for simulation,
due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := objectMemory integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
+ objectMemory setRootTable: (Array new: ObjectMemory rootTableSize).
+ objectMemory setWeakRoots: (Array new: ObjectMemory rootTableSize + ObjectMemory remapBufferSize + 100).
+ objectMemory setRemapBuffer: (Array new: ObjectMemory remapBufferSize).
- objectMemory rootTable: (Array new: ObjectMemory rootTableSize).
- objectMemory weakRoots: (Array new: ObjectMemory rootTableSize + ObjectMemory remapBufferSize + 100).
- objectMemory remapBuffer: (Array new: ObjectMemory remapBufferSize).
semaphoresUseBufferA := true.
semaphoresToSignalA := Array new: SemaphoresToSignalSize.
semaphoresToSignalB := Array new: SemaphoresToSignalSize.
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
primitiveTable := self class primitiveTable.
pluginList := #().
mappedPluginEntries := #().
"initialize InterpreterSimulator variables used for debugging"
byteCount := 0.
sendCount := 0.
quitBlock := [^ self].
traceOn := true.
myBitBlt := BitBltSimulator new setInterpreter: self.
filesOpen := OrderedCollection new.
+ objectMemory setHeaderTypeBytes: (CArrayAccessor on: (Array with: bytesPerWord * 2 with: bytesPerWord with: 0 with: 0)).
- objectMemory headerTypeBytes: (CArrayAccessor on: (Array with: bytesPerWord * 2 with: bytesPerWord with: 0 with: 0)).
transcript := Transcript.
objectMemory transcript: Transcript.
displayForm := 'Display has not yet been installed' asDisplayText form.
!
Item was changed:
----- Method: InterpreterSimulator>>lookupMethodInClass: (in category 'debug support') -----
lookupMethodInClass: class
| currentClass dictionary found rclass |
"This method overrides the interp, causing a halt on MNU."
"true ifTrue: [^ super lookupMethodInClass: class]." "Defeat debug support"
currentClass := class.
+ [currentClass ~= objectMemory getNilObj]
- [currentClass ~= objectMemory nilObj]
whileTrue:
[dictionary := objectMemory fetchPointer: MessageDictionaryIndex ofObject: currentClass.
+ dictionary = objectMemory getNilObj ifTrue:
- dictionary = objectMemory nilObj ifTrue:
["MethodDict pointer is nil (hopefully due a swapped out stub)
-- raise exception #cannotInterpret:."
objectMemory pushRemappableOop: currentClass. "may cause GC!!"
self createActualMessageTo: class.
currentClass := objectMemory popRemappableOop.
messageSelector := objectMemory splObj: SelectorCannotInterpret.
^ self lookupMethodInClass: (self superclassOf: currentClass)].
found := self lookupMethodInDictionary: dictionary.
found ifTrue: [^ methodClass := currentClass].
currentClass := self superclassOf: currentClass].
"Could not find #doesNotUnderstand: -- unrecoverable error."
messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue:
[self error: 'Recursive not understood error encountered'].
self halt: (self stringOf: messageSelector).
"Cound not find a normal message -- raise exception #doesNotUnderstand:"
objectMemory pushRemappableOop: class. "may cause GC!!"
self createActualMessageTo: class.
rclass := objectMemory popRemappableOop.
messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
^ self lookupMethodInClass: rclass!
Item was changed:
----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') -----
makeDirEntryName: entryName size: entryNameSize
createDate: createDate modDate: modifiedDate
isDir: dirFlag fileSize: fileSize
| modDateOop createDateOop nameString results |
self var: 'entryName' type: 'char *'.
"allocate storage for results, remapping newly allocated
oops in case GC happens during allocation"
objectMemory pushRemappableOop:
(objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 5).
objectMemory pushRemappableOop:
(objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize)..
objectMemory pushRemappableOop: (self positive32BitIntegerFor: createDate).
objectMemory pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
modDateOop := objectMemory popRemappableOop.
createDateOop := objectMemory popRemappableOop.
nameString := objectMemory popRemappableOop.
results := objectMemory popRemappableOop.
1 to: entryNameSize do: [ :i |
objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
].
objectMemory storePointer: 0 ofObject: results withValue: nameString.
objectMemory storePointer: 1 ofObject: results withValue: createDateOop.
objectMemory storePointer: 2 ofObject: results withValue: modDateOop.
dirFlag
+ ifTrue: [ objectMemory storePointer: 3 ofObject: results withValue: objectMemory getTrueObj ]
+ ifFalse: [ objectMemory storePointer: 3 ofObject: results withValue: objectMemory getFalseObj ].
- ifTrue: [ objectMemory storePointer: 3 ofObject: results withValue: objectMemory trueObj ]
- ifFalse: [ objectMemory storePointer: 3 ofObject: results withValue: objectMemory falseObj ].
objectMemory storePointer: 4 ofObject: results
withValue: (objectMemory integerObjectOf: fileSize).
^ results
!
Item was changed:
----- Method: InterpreterSimulator>>objectBefore: (in category 'testing') -----
objectBefore: addr
| oop prev |
oop := objectMemory firstObject.
+ [oop < objectMemory getEndOfMemory] whileTrue: [
- [oop < objectMemory endOfMemory] whileTrue: [
prev := oop. "look here if debugging prev obj overlapping this one"
oop := objectMemory objectAfter: oop.
oop >= addr ifTrue: [^ prev]
]!
Item was changed:
----- Method: InterpreterSimulator>>openOn:extraMemory: (in category 'initialization') -----
openOn: fileName extraMemory: extraBytes
"InterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
| f headerSize count oldBaseAddr bytesToShift swapBytes hasPlatformFloatOrdering |
"open image file and read the header"
["begin ensure block..."
f := FileStream readOnlyFileNamed: fileName.
imageName := f fullName.
f binary.
swapBytes := self checkImageVersionFrom: f startingAt: 0.
"This interpreter does not use native float word order. Clear bit 1of format number."
imageFormatVersionNumber := imageFormatInitialVersion bitAnd: -2.
"If bit 1 was set set in the image file header, float word order must be normalized."
hasPlatformFloatOrdering := (imageFormatInitialVersion bitAnd: 1) = 1.
headerSize := self nextLongFrom: f swap: swapBytes.
+ objectMemory setEndOfMemory: (self nextLongFrom: f swap: swapBytes). "first unused location in heap"
- objectMemory endOfMemory: (self nextLongFrom: f swap: swapBytes). "first unused location in heap"
oldBaseAddr := self nextLongFrom: f swap: swapBytes. "object memory base address of image"
+ objectMemory setSpecialObjectsOop: (self nextLongFrom: f swap: swapBytes).
+ objectMemory setLastHash: (self nextLongFrom: f swap: swapBytes). "Should be loaded from, and saved to the image header"
+ objectMemory getLastHash = 0 ifTrue: [objectMemory setLastHash: 999].
- objectMemory specialObjectsOop: (self nextLongFrom: f swap: swapBytes).
- objectMemory lastHash: (self nextLongFrom: f swap: swapBytes). "Should be loaded from, and saved to the image header"
- objectMemory lastHash = 0 ifTrue: [objectMemory lastHash: 999].
savedWindowSize := self nextLongFrom: f swap: swapBytes.
fullScreenFlag := self oldFormatFullScreenFlag: (self nextLongFrom: f swap: swapBytes).
extraVMMemory := self nextLongFrom: f swap: swapBytes.
"allocate interpreter memory"
+ objectMemory setMemoryLimit: (objectMemory getEndOfMemory + extraBytes).
- objectMemory memoryLimit: (objectMemory endOfMemory + extraBytes).
"read in the image in bulk, then swap the bytes if necessary"
f position: headerSize.
+ objectMemory setMemory: (Bitmap new: objectMemory getMemoryLimit // 4).
+ count := f readInto: objectMemory getMemory startingAt: 1 count: objectMemory getEndOfMemory // 4.
+ count ~= (objectMemory getEndOfMemory // 4) ifTrue: [self halt].
- objectMemory memory: (Bitmap new: objectMemory memoryLimit // 4).
- count := f readInto: objectMemory memory startingAt: 1 count: objectMemory endOfMemory // 4.
- count ~= (objectMemory endOfMemory // 4) ifTrue: [self halt].
]
ensure: [f close].
swapBytes ifTrue: [Utilities informUser: 'Swapping bytes of foreign image...'
during: [self reverseBytesInImage]].
self initialize.
bytesToShift := 0 - oldBaseAddr. "adjust pointers for zero base address"
+ objectMemory setEndOfMemory: objectMemory getEndOfMemory.
- objectMemory endOfMemory: objectMemory endOfMemory.
Utilities informUser: 'Relocating object pointers...'
during: [self initializeInterpreter: bytesToShift].
hasPlatformFloatOrdering ifTrue: [
"Low order bit set, indicating that the image was saved from
a StackInterpreter (Cog) VM. Storage of all Float objects must be
returned to older object memory format."
Utilities informUser: 'Swapping words in float objects...'
during: [self normalizeFloatOrderingInImage]].
!
Item was changed:
----- Method: InterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
primitiveDirectoryLookup
| index pathName array result |
index := self stackIntegerValue: 0.
pathName := (self stringOf: (self stackValue: 1)).
self successful ifFalse: [
^self primitiveFail.
].
array := FileDirectory default primLookupEntryIn: pathName index: index.
array == nil ifTrue: [
self pop: 3.
+ self push: objectMemory getNilObj.
- self push: objectMemory nilObj.
^array.
].
array == #badDirectoryPath ifTrue: [self halt.
^self primitiveFail.
].
result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
createDate: (array at: 2) modDate: (array at: 3)
isDir: (array at: 4) fileSize: (array at: 5).
self pop: 3.
self push: result.
!
Item was changed:
----- Method: InterpreterSimulator>>primitiveKbdNext (in category 'I/O primitives') -----
primitiveKbdNext
self pop: 1.
Sensor keyboardPressed
ifTrue: [self pushInteger: Sensor primKbdNext]
+ ifFalse: [self push: objectMemory getNilObj]!
- ifFalse: [self push: objectMemory nilObj]!
Item was changed:
----- Method: InterpreterSimulator>>primitiveKbdPeek (in category 'I/O primitives') -----
primitiveKbdPeek
self pop: 1.
Sensor keyboardPressed
ifTrue: [self pushInteger: Sensor primKbdPeek]
+ ifFalse: [self push: objectMemory getNilObj]!
- ifFalse: [self push: objectMemory nilObj]!
Item was changed:
----- Method: InterpreterSimulator>>printStack: (in category 'debug support') -----
printStack: includeTemps
| ctxt |
ctxt := activeContext.
^ String streamContents:
[:strm |
[self printStackFrame: ctxt onStream: strm.
includeTemps ifTrue: [self printStackTemps: ctxt onStream: strm].
+ (ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory getNilObj]
- (ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory nilObj]
whileFalse: [].
]!
Item was changed:
----- Method: InterpreterSimulator>>printTop: (in category 'debug support') -----
printTop: n
"Print important fields of the top n contexts"
| ctxt classAndSel home top ip sp |
ctxt := activeContext.
^ String streamContents:
[:strm | 1 to: n do:
[:i |
home := (objectMemory fetchClassOf: ctxt) = (objectMemory splObj: ClassBlockContext)
ifTrue: [objectMemory fetchPointer: HomeIndex ofObject: ctxt]
ifFalse: [ctxt].
classAndSel := self
classAndSelectorOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: home)
forReceiver: (objectMemory fetchPointer: ReceiverIndex ofObject: home).
strm cr; nextPutAll: ctxt hex8.
ctxt = home ifFalse: [strm nextPutAll: ' [] in'].
strm space; nextPutAll: (self nameOfClass: classAndSel first).
strm nextPutAll: '>>'; nextPutAll: (self shortPrint: classAndSel last).
ctxt = activeContext
ifTrue: [ip := instructionPointer - method - (objectMemory baseHeaderSize - 2).
sp := self stackPointerIndex - TempFrameStart + 1.
top := self stackTop]
ifFalse: [ip := objectMemory integerValueOf:
(objectMemory fetchPointer: InstructionPointerIndex ofObject: ctxt).
sp := objectMemory integerValueOf:
(objectMemory fetchPointer: StackPointerIndex ofObject: ctxt).
top := objectMemory longAt: ctxt + (objectMemory lastPointerOf: ctxt)].
strm cr; tab; nextPutAll: 'ip = '; print: ip.
strm cr; tab; nextPutAll: 'sp = '; print: sp.
strm cr; tab; nextPutAll: 'top = '; nextPutAll: (self shortPrint: top).
+ (ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory getNilObj
- (ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory nilObj
ifTrue: [^strm contents].
].
]!
Item was changed:
----- Method: InterpreterSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
reverseBytesFrom: begin to: end
"Byte-swap the given range of memory (not inclusive!!)."
| wordAddr |
wordAddr := begin.
+ objectMemory getMemory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
- objectMemory memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: InterpreterSimulator>>rewriteImageFileNamed: (in category 'image save/restore') -----
rewriteImageFileNamed: fileName
"Write an image file on a file named fileName using the window size that
was provided by the original image file. This is intended for rewriting an
image file that has been read from a disk file, but that has not yet been
run in the interpreter. This may be used to load an image file that had been
saved by another type of interpreter, and resaving it in the format used by
this interpreter. For example, an image that has been saved as format 6505
(indicating use of native float word ordering for a Cog VM) may be resaved
in format 6504."
"(InterpreterSimulator new openOn: Smalltalk imageName) rewriteImageFileNamed: 'newimagefile.image' "
| file numberOfBytesToWrite |
bytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
+ numberOfBytesToWrite := objectMemory getFreeBlock - objectMemory startOfMemory.
- numberOfBytesToWrite := objectMemory freeBlock - objectMemory startOfMemory.
[
file := (FileStream fileNamed: fileName) binary.
file == nil ifTrue: [^nil].
Utilities informUser: 'Writing image to ''', fileName, '''...'
during: [self writeImageFile: file size: numberOfBytesToWrite screenSize: savedWindowSize]
]
ensure: [file close]!
Item was changed:
----- Method: InterpreterSimulator>>showDisplayBits:w:h:d:left:right:top:bottom: (in category 'I/O primitives') -----
showDisplayBits: destBits w: w h: h d: d left: left right: right top: top bottom: bottom
| raster pixPerWord simDisp realDisp rect |
pixPerWord := 32 // d.
raster := displayForm width + (pixPerWord - 1) // pixPerWord.
+ simDisp := Form new hackBits: objectMemory getMemory.
- simDisp := Form new hackBits: objectMemory memory.
displayForm unhibernate.
realDisp := Form new hackBits: displayForm bits.
realDisp
copy: (0 @ (top * raster) extent: 4 @ (bottom - top * raster))
from: 0 @ (destBits // 4 + (top * raster))
in: simDisp
rule: Form over.
displayView ifNotNil: [^ displayView changed].
"If running without a view, just blat the bits onto the screen..."
rect := 0 @ top corner: displayForm width @ bottom.
Display
copy: (rect translateBy: self displayLocation)
from: rect topLeft
in: displayForm
rule: Form over!
Item was changed:
----- Method: InterpreterSimulator>>stackDepth (in category 'testing') -----
stackDepth
| ctxt n |
ctxt := activeContext.
n := 0.
+ [(ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory getNilObj]
- [(ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory nilObj]
whileFalse: [n := n+1].
^ n!
Item was changed:
----- Method: InterpreterSimulator>>stats (in category 'testing') -----
stats
| oop fieldAddr fieldOop last stats v d |
stats := Bag new.
oop := objectMemory firstObject.
'Scanning the image...' displayProgressAt: Sensor cursorPoint
+ from: oop to: objectMemory getEndOfMemory
- from: oop to: objectMemory endOfMemory
during: [:bar |
+ [oop < objectMemory getEndOfMemory] whileTrue:
- [oop < objectMemory endOfMemory] whileTrue:
[(objectMemory isFreeObject: oop) ifFalse:
[stats add: #objects.
fieldAddr := oop + (objectMemory lastPointerOf: oop).
[fieldAddr > oop] whileTrue:
[fieldOop := objectMemory longAt: fieldAddr.
(objectMemory isIntegerObject: fieldOop)
ifTrue: [v := objectMemory integerValueOf: fieldOop.
(v between: -16000 and: 16000)
ifTrue: [stats add: #ints32k]
ifFalse: [stats add: #intsOther]]
+ ifFalse: [fieldOop = objectMemory getNilObj ifTrue: [stats add: #nil]
- ifFalse: [fieldOop = objectMemory nilObj ifTrue: [stats add: #nil]
ifFalse:
[d := fieldOop - oop.
(d between: -16000 and: 16000)
ifTrue: [stats add: #oops32k]
ifFalse: [stats add: #oopsOther]]].
fieldAddr := fieldAddr - bytesPerWord]].
bar value: oop.
last := oop.
last := last.
oop := objectMemory objectAfter: oop]].
^ stats sortedElements!
Item was changed:
----- Method: InterpreterSimulator>>storeAndPopReceiverVariableBytecode (in category 'bytecode routines') -----
storeAndPopReceiverVariableBytecode
"Note: This code uses storePointerUnchecked:ofObject:withValue: and does the store check explicitely in order to help the translator produce better code."
"Interpreter version has fetchNextBytecode out of order"
| rcvr top |
rcvr := receiver.
top := self internalStackTop.
+ (rcvr < objectMemory getYoungStart) ifTrue: [
- (rcvr < objectMemory youngStart) ifTrue: [
objectMemory possibleRootStoreInto: rcvr value: top.
].
objectMemory storePointerUnchecked: (currentBytecode bitAnd: 7)
ofObject: rcvr
withValue: top.
self internalPop: 1.
self fetchNextBytecode.
!
Item was changed:
----- Method: InterpreterSimulator>>validOop: (in category 'testing') -----
validOop: oop
" Return true if oop appears to be valid "
(oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
(oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
+ oop >= objectMemory getEndOfMemory ifTrue: [^ false]. "Out of range"
- oop >= objectMemory endOfMemory ifTrue: [^ false]. "Out of range"
"could test if within the first large freeblock"
(objectMemory longAt: oop) = 4 ifTrue: [^ false].
(objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object"
^ true!
Item was changed:
----- Method: InterpreterSimulator>>validate (in category 'testing') -----
validate
| oop prev |
transcript show: 'Validating...'.
oop := objectMemory firstObject.
+ [oop < objectMemory getEndOfMemory] whileTrue: [
- [oop < objectMemory endOfMemory] whileTrue: [
self validate: oop.
prev := oop. "look here if debugging prev obj overlapping this one"
oop := objectMemory objectAfter: oop.
].
prev := prev. "Don't offer to delete this please"
transcript show: 'done.'; cr!
Item was changed:
----- Method: InterpreterSimulator>>validate: (in category 'testing') -----
validate: oop
| header type cc sz fmt nextChunk |
header := objectMemory longAt: oop.
type := header bitAnd: 3.
type = 2 ifFalse: [type = (objectMemory rightType: header) ifFalse: [self halt]].
sz := (header bitAnd: objectMemory sizeMask) >> 2.
(objectMemory isFreeObject: oop)
ifTrue: [ nextChunk := oop + (objectMemory sizeOfFree: oop) ]
ifFalse: [ nextChunk := oop + (objectMemory sizeBitsOf: oop) ].
+ nextChunk > objectMemory getEndOfMemory
+ ifTrue: [oop = objectMemory getEndOfMemory ifFalse: [self halt]].
- nextChunk > objectMemory endOfMemory
- ifTrue: [oop = objectMemory endOfMemory ifFalse: [self halt]].
(objectMemory headerType: nextChunk) = 0 ifTrue: [
(objectMemory headerType: (nextChunk + (bytesPerWord * 2))) = 0 ifFalse: [self halt]].
(objectMemory headerType: nextChunk) = 1 ifTrue: [
(objectMemory headerType: (nextChunk + bytesPerWord)) = 1 ifFalse: [self halt]].
type = 2 ifTrue:
["free block" ^ self].
fmt := (header >> 8) bitAnd: 16rF.
cc := (header >> 12) bitAnd: 31.
cc > 16 ifTrue: [self halt]. "up to 32 are legal, but not used"
type = 0 ifTrue:
["three-word header"
((objectMemory longAt: oop - bytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
((objectMemory longAt: oop-(bytesPerWord * 2)) bitAnd: 3) = type ifFalse: [self halt].
((objectMemory longAt: oop - bytesPerWord) = type) ifTrue: [self halt]. "Class word is 0"
sz = 0 ifFalse: [self halt]].
type = 1 ifTrue:
["two-word header"
((objectMemory longAt: oop - bytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
cc > 0 ifTrue: [sz = 1 ifFalse: [self halt]].
sz = 0 ifTrue: [self halt]].
type = 3 ifTrue:
["one-word header"
cc = 0 ifTrue: [self halt]].
fmt = 5 ifTrue: [self halt].
fmt = 7 ifTrue: [self halt].
fmt >= 12 ifTrue:
["CompiledMethod -- check for integer header"
(objectMemory isIntegerObject: (objectMemory longAt: oop + bytesPerWord)) ifFalse: [self halt]].!
Item was changed:
----- Method: InterpreterSimulator>>writeImageFile:size:screenSize: (in category 'image save/restore') -----
writeImageFile: file size: numberOfBytesToWrite screenSize: screenSize
"Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
| headerSize |
objectMemory bytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
headerSize := 16 * self bytesPerWord.
{
self imageFormatVersion.
headerSize.
numberOfBytesToWrite.
objectMemory startOfMemory.
+ objectMemory getSpecialObjectsOop.
+ objectMemory getLastHash.
- objectMemory specialObjectsOop.
- objectMemory lastHash.
screenSize.
fullScreenFlag.
extraVMMemory
}
do: [:long | self putLong: long toFile: file].
"Pad the rest of the header."
7 timesRepeat: [self putLong: 0 toFile: file].
"Position the file after the header."
file position: headerSize.
"Write the object memory."
1 to: numberOfBytesToWrite // 4
do: [:index |
self
+ putLong: (objectMemory getMemory at: index)
- putLong: (objectMemory memory at: index)
toFile: file].
self success: true
!
Item was changed:
----- Method: InterpreterSimulator>>writeImageFileIO: (in category 'image save/restore') -----
writeImageFileIO: numberOfBytesToWrite
"Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
| headerSize file |
bytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
headerSize := 16 * bytesPerWord.
[
file := (FileStream fileNamed: imageName) binary.
file == nil ifTrue: [^nil].
{
self imageFormatVersion.
headerSize.
numberOfBytesToWrite.
objectMemory startOfMemory.
+ objectMemory getSpecialObjectsOop.
+ objectMemory getLastHash.
- objectMemory specialObjectsOop.
- objectMemory lastHash.
self ioScreenSize.
fullScreenFlag.
extraVMMemory
}
do: [:long | self putLong: long toFile: file].
"Pad the rest of the header."
7 timesRepeat: [self putLong: 0 toFile: file].
"Position the file after the header."
file position: headerSize.
"Write the object memory."
1
to: numberOfBytesToWrite // 4
do: [:index |
self
+ putLong: (objectMemory getMemory at: index)
- putLong: (objectMemory memory at: index)
toFile: file].
self success: true
]
ensure: [file close]!
Item was changed:
----- Method: InterpreterSimulatorLSB>>displayForm: (in category 'debug support') -----
displayForm: f
| width height depth bits realForm simDisp realDisp |
bits := objectMemory fetchPointer: 0 ofObject: f.
width := self fetchInteger: 1 ofObject: f.
height := self fetchInteger: 2 ofObject: f.
depth := self fetchInteger: 3 ofObject: f.
realForm := Form extent: width@height depth: depth.
+ simDisp := Form new hackBits: objectMemory getMemory.
- simDisp := Form new hackBits: objectMemory memory.
realDisp := Form new hackBits: realForm bits.
realDisp
copy: (0 @ 0 extent: 4 @ realForm bits size)
from: (0 @ (bits + 4 // 4))
in: simDisp
rule: Form over.
realForm displayOn: Display at: 0@0.!
Item was removed:
- ----- Method: NewObjectMemory>>edenBytes: (in category 'accessing') -----
- edenBytes: aValue
- ^edenBytes := aValue!
Item was removed:
- ----- Method: NewObjectMemory>>falseObject: (in category 'accessing') -----
- falseObject: anOop
- "For mapInterpreterOops"
- falseObj := anOop!
Item was removed:
- ----- Method: NewObjectMemory>>freeStart: (in category 'accessing') -----
- freeStart: aValue
- ^freeStart := aValue!
Item was added:
+ ----- Method: NewObjectMemory>>getYoungStart (in category 'cog jit support') -----
+ getYoungStart
+ <cmacro: '() GIV(youngStart)'>
+ <returnTypeC: #usqInt>
+ ^youngStart!
Item was removed:
- ----- Method: NewObjectMemory>>heapMapAtWord: (in category 'debug printing') -----
- heapMapAtWord: wordPointer
- "Implemented in support code for Cog branch in Cross/vm/sqHeapMap.c and
- stubbed out here for use with trunk platform sources"
-
- self flag: #FIXME. "remove this method and add sqHeapMap.c to Cross when 64 bit address space can be supported"
- ^ 1
-
- "
- /*
- * Answer non-zero if the heapMap is set at wordPointer, 0 otherwise
- */
- int heapMapAtWord(void *wordPointer)
- { . . . }
- "!
Item was removed:
- ----- Method: NewObjectMemory>>needGCFlag: (in category 'accessing') -----
- needGCFlag: aValue
- ^needGCFlag := aValue!
Item was changed:
----- Method: NewObjectMemory>>postGCAction: (in category 'garbage collection') -----
postGCAction: fullGCFlag
"Shrink free memory and signal the gc semaphore."
| freeSizeNow |
freeSizeNow := self freeSize.
+ (freeSizeNow > self getShrinkThreshold
+ and: [freeSizeNow > self getGrowHeadroom]) ifTrue:
- (freeSizeNow > self shrinkThreshold
- and: [freeSizeNow > self growHeadroom]) ifTrue:
["Attempt to shrink memory after successfully reclaiming lots of memory"
+ self shrinkObjectMemory: freeSizeNow - self getGrowHeadroom].
- self shrinkObjectMemory: freeSizeNow - self growHeadroom].
+ interpreter signalSemaphoreWithIndex: self getGcSemaphoreIndex!
- interpreter signalSemaphoreWithIndex: self gcSemaphoreIndex!
Item was added:
+ ----- Method: NewObjectMemory>>setEdenBytes: (in category 'accessing') -----
+ setEdenBytes: aValue
+ ^edenBytes := aValue!
Item was added:
+ ----- Method: NewObjectMemory>>setFalseObject: (in category 'accessing') -----
+ setFalseObject: anOop
+ "For mapInterpreterOops"
+ falseObj := anOop!
Item was added:
+ ----- Method: NewObjectMemory>>setFreeStart: (in category 'accessing') -----
+ setFreeStart: aValue
+ ^freeStart := aValue!
Item was added:
+ ----- Method: NewObjectMemory>>setNeedGCFlag: (in category 'accessing') -----
+ setNeedGCFlag: aValue
+ ^needGCFlag := aValue!
Item was added:
+ ----- Method: NewObjectMemory>>setTrueObject: (in category 'accessing') -----
+ setTrueObject: anOop
+ "For mapInterpreterOops"
+ trueObj := anOop!
Item was changed:
+ ----- Method: NewObjectMemory>>startOfFreeSpace (in category 'accessing') -----
- ----- Method: NewObjectMemory>>startOfFreeSpace (in category 'memory access') -----
startOfFreeSpace
+ <returnTypeC: #usqInt>
- <inline: true>
^freeStart!
Item was removed:
- ----- Method: NewObjectMemory>>trueObject: (in category 'accessing') -----
- trueObject: anOop
- "For mapInterpreterOops"
- trueObj := anOop!
Item was removed:
- ----- Method: NewObjectMemory>>youngStart (in category 'cog jit support') -----
- youngStart
- <cmacro: '() GIV(youngStart)'>
- ^youngStart!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>setHeaderTypeBytes: (in category 'initialization') -----
+ setHeaderTypeBytes: array
+ headerTypeBytes := array!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>setInterpreter: (in category 'initialization') -----
+ setInterpreter: anInterpreter
+ interpreter := anInterpreter!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>setRemapBuffer: (in category 'initialization') -----
+ setRemapBuffer: table
+ remapBuffer := table!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>setRootTable: (in category 'initialization') -----
+ setRootTable: table
+ rootTable := table!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>setWeakRoots: (in category 'initialization') -----
+ setWeakRoots: table
+ weakRoots := table!
Item was changed:
----- Method: NewObjectMemorySimulator>>sqGrowMemory:By: (in category 'memory access') -----
sqGrowMemory: oldLimit By: delta
| newMemory |
coInterpreter transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr.
memory size * 4 < (oldLimit + delta) ifTrue:
[newMemory := (memory class new: oldLimit + delta + 3 // 4).
newMemory replaceFrom: 1 to: memory size with: memory startingAt: 1.
+ coInterpreter setMemory: (memory := newMemory)].
- coInterpreter memory: (memory := newMemory)].
^memory size * 4!
Item was changed:
VMClass subclass: #ObjectMemory
+ instanceVariableNames: 'interpreter memory youngStart endOfMemory memoryLimit nilObj falseObj trueObj specialObjectsOop rootTable rootTableCount extraRoots extraRootCount weakRoots weakRootCount child field parentField freeBlock lastHash allocationCount lowSpaceThreshold signalLowSpace compStart compEnd fwdTableNext fwdTableLast remapBuffer remapBufferCount allocationsBetweenGCs tenuringThreshold gcSemaphoreIndex gcBiasToGrow gcBiasToGrowGCLimit gcBiasToGrowThreshold statFullGCs statFullGCMSecs statFullGCUsecs statIncrGCs statIncrGCMSecs statIncrGCUsecs statIGCDeltaUsecs statTenures statRootTableOverflows freeContexts freeLargeContexts totalObjectCount shrinkThreshold growHeadroom headerTypeBytes youngStartLocal statMarkCount statSweepCount statMkFwdCount statCompMoveCount statGrowMemory statShrinkMemory statRootTableCount statAllocationCount statSurvivorCount statGCTime statSpecialMarkCount statIGCDeltaTime statpendingFinalizationSignals forceTenureFlag gcStartUsecs rootTableOverflowed'
- instanceVariableNames: 'interpreter memory youngStart endOfMemory memoryLimit nilObj falseObj trueObj specialObjectsOop rootTable rootTableCount extraRoots extraRootCount weakRoots weakRootCount child field parentField freeBlock lastHash allocationCount lowSpaceThreshold signalLowSpace compStart compEnd fwdTableNext fwdTableLast remapBuffer remapBufferCount allocationsBetweenGCs tenuringThreshold gcSemaphoreIndex gcBiasToGrow gcBiasToGrowGCLimit gcBiasToGrowThreshold statFullGCs statFullGCMSecs statFullGCUsecs statIncrGCs statIncrGCMSecs statIncrGCUsecs statIGCDeltaUsecs statTenures statRootTableOverflows freeContexts freeLargeContexts totalObjectCount shrinkThreshold growHeadroom headerTypeBytes youngStartLocal statMarkCount statSweepCount statMkFwdCount statCompMoveCount statGrowMemory statShrinkMemory statRootTableCount statAllocationCount statSurvivorCount statGCTime statSpecialMarkCount statIGCDeltaTime statpendingFinalizationSignals forceTenureFlag gcStartUsecs'
classVariableNames: 'Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask ClassPseudoContext ClassTranslatedMethod ContextFixedSizePlusHeader Done ExtraRootSize GCTopMarker HashBits HeaderTypeClass HeaderTypeFree HeaderTypeGC InvokeCallbackSelector NilContext RemapBufferSize RootTableRedZone RootTableSize StartField StartObj Upward'
poolDictionaries: 'VMBasicConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants'
category: 'VMMaker-Interpreter'!
!ObjectMemory commentStamp: '<historical>' prior: 0!
This class describes a 32-bit direct-pointer object memory for Smalltalk. The model is very simple in principle: a pointer is either a SmallInteger or a 32-bit direct object pointer.
SmallIntegers are tagged with a low-order bit equal to 1, and an immediate 31-bit 2s-complement signed value in the rest of the word.
All object pointers point to a header, which may be followed by a number of data fields. This object memory achieves considerable compactness by using a variable header size (the one complexity of the design). The format of the 0th header word is as follows:
3 bits reserved for gc (mark, root, unused)
12 bits object hash (for HashSets)
5 bits compact class index
4 bits object format
6 bits object size in 32-bit words
2 bits header type (0: 3-word, 1: 2-word, 2: forbidden, 3: 1-word)
If a class is in the compact class table, then this is the only header information needed. If it is not, then it will have another header word at offset -4 bytes with its class in the high 30 bits, and the header type repeated in its low 2 bits. It the objects size is greater than 255 bytes, then it will have yet another header word at offset -8 bytes with its full word size in the high 30 bits and its header type repeated in the low two bits.
The object format field provides the remaining information as given in the formatOf: method (including isPointers, isVariable, isBytes, and the low 2 size bits of byte-sized objects).
This implementation includes incremental (2-generation) and full garbage collection, each with compaction and rectification of direct pointers. It also supports a bulk-become (exchange object identity) feature that allows many objects to be becomed at once, as when all instances of a class must be grown or shrunk.
There is now a simple 64-bit version of the object memory. It is the simplest possible change that could work. It merely sign-extends all integer oops, and extends all object headers and oops by adding 32 zeroes in the high bits. The format of the base header word is changed in one minor, not especially elegant, way. Consider the old 32-bit header:
ggghhhhhhhhhhhhcccccffffsssssstt
The 64-bit header is almost identical, except that the size field (now being in units of 8 bytes, has a zero in its low-order bit. At the same time, the byte-size residue bits for byte objects, which are in the low order bits of formats 8-11 and 12-15, are now in need of another bit of residue. So, the change is as follows:
ggghhhhhhhhhhhhcccccffffsssssrtt
where bit r supplies the 4's bit of the byte size residue for byte objects. Oh, yes, this is also needed now for 'variableWord' objects, since their size in 32-bit words requires a low-order bit.
See the comment in formatOf: for the change allowing for 64-bit wide bitmaps, now dubbed 'variableLong'.!
Item was removed:
- ----- Method: ObjectMemory>>allocationsBetweenGCs (in category 'accessing') -----
- allocationsBetweenGCs
- ^allocationsBetweenGCs!
Item was removed:
- ----- Method: ObjectMemory>>allocationsBetweenGCs: (in category 'accessing') -----
- allocationsBetweenGCs: count
- allocationsBetweenGCs := count!
Item was changed:
----- Method: ObjectMemory>>checkHeapIntegrity (in category 'memory access') -----
checkHeapIntegrity
"Perform an integrity/leak check using the heapMap. Assume
clearLeakMapAndMapAccessibleObjects has set a bit at each
object's header. Scan all objects in the heap checking that every
pointer points to a header. Scan the rootTable, remapBuffer and
extraRootTable checking that every entry is a pointer to a header.
Check that the number of roots is correct and that all rootTable
entries have their rootBit set. Answer if all checks pass."
| ok obj sz hdr fmt fi fieldOop numRootsInHeap |
<inline: false>
ok := true.
numRootsInHeap := 0.
obj := self firstObject.
[self oop: obj isLessThan: self startOfFreeSpace] whileTrue:
[(self isFreeObject: obj)
ifTrue:
[sz := self sizeOfFree: obj]
ifFalse:
[hdr := self baseHeader: obj.
+ (self isYoungRootHeader: hdr) ifTrue:
- (hdr bitAnd: self rootBit) ~= 0 ifTrue:
[numRootsInHeap := numRootsInHeap + 1].
(self compactClassIndexOfHeader: hdr) = 0 ifTrue:
[fieldOop := (self classHeader: obj) bitAnd: self allButTypeMask.
((self isIntegerObject: fieldOop)
or: [(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
[self print: 'object leak in '; printHex: obj; print: ' class = '; printHex: fieldOop; cr.
ok := false]].
fmt := self formatOfHeader: hdr.
+ (fmt <= self lastPointerFormat or: [fmt >= self firstCompiledMethodFormat]) ifTrue:
+ [fmt >= self firstCompiledMethodFormat
+ ifTrue: [fi := (self literalCountOf: obj) + LiteralStart]
+ ifFalse: [(fmt = self indexablePointersFormat and: [self isContextHeader: hdr])
- (fmt <= 4 "pointers" or: [fmt >= 12 "compiled method"]) ifTrue:
- [fmt >= 12
- ifTrue: [fi := (self literalCountOf: obj) + 1 "+ 1 = methodHeader slot"]
- ifFalse: [(fmt = 3 and: [self isContextHeader: hdr])
ifTrue: [fi := CtxtTempFrameStart + (self fetchStackPointerOf: obj)]
ifFalse: [fi := self lengthOf: obj]].
[(fi := fi - 1) >= 0] whileTrue:
[fieldOop := self fetchPointer: fi ofObject: obj.
(self isNonIntegerObject: fieldOop) ifTrue:
[(fieldOop bitAnd: self bytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
ok := false]
ifFalse:
[(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
[self print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
ok := false]]]]].
sz := self sizeBitsOf: obj].
obj := self oopFromChunk: obj + sz].
numRootsInHeap ~= rootTableCount ifTrue:
[self print: 'root count mismatch. #heap roots '; printNum: numRootsInHeap; print: '; #roots '; printNum: rootTableCount; cr.
+ "But the system copes with overflow..."
+ ok := rootTableOverflowed and: [allocationCount > allocationsBetweenGCs]].
- ok := false].
1 to: rootTableCount do:
[:ri|
obj := rootTable at: ri.
(obj bitAnd: self bytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned oop in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
ok := false]
ifFalse:
[(self heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[self print: 'object leak in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
ok := false]
ifFalse:
[hdr := self baseHeader: obj.
+ (self isYoungRootHeader: hdr) ifFalse:
- (hdr bitAnd: self rootBit) = 0 ifTrue:
[self print: 'non-root in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
ok := false]]]].
1 to: remapBufferCount do:
[:ri|
obj := remapBuffer at: ri.
(obj bitAnd: self bytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
ok := false]
ifFalse:
[(self heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[self print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
ok := false]]].
1 to: extraRootCount do:
[:ri|
obj := (extraRoots at: ri) at: 0.
(obj bitAnd: self bytesPerWord - 1) ~= 0
ifTrue:
[self print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
ok := false]
ifFalse:
[(self heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[self print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
ok := false]]].
^ok!
Item was removed:
- ----- Method: ObjectMemory>>endOfMemory (in category 'accessing') -----
- endOfMemory
- "Simulation support"
- ^endOfMemory!
Item was removed:
- ----- Method: ObjectMemory>>endOfMemory: (in category 'accessing') -----
- endOfMemory: position
- "Simulation support"
- endOfMemory := position!
Item was removed:
- ----- Method: ObjectMemory>>falseObj (in category 'accessing') -----
- falseObj
- ^falseObj!
Item was removed:
- ----- Method: ObjectMemory>>falseObj: (in category 'accessing') -----
- falseObj: oop
- falseObj := oop!
Item was added:
+ ----- Method: ObjectMemory>>firstCompiledMethodFormat (in category 'header formats') -----
+ firstCompiledMethodFormat
+ <api>
+ ^12!
Item was removed:
- ----- Method: ObjectMemory>>forceTenureFlag: (in category 'accessing') -----
- forceTenureFlag: arg
- forceTenureFlag := arg!
Item was removed:
- ----- Method: ObjectMemory>>freeBlock (in category 'accessing') -----
- freeBlock
- ^freeBlock!
Item was removed:
- ----- Method: ObjectMemory>>freeContexts (in category 'accessing') -----
- freeContexts
- ^freeContexts!
Item was removed:
- ----- Method: ObjectMemory>>freeContexts: (in category 'accessing') -----
- freeContexts: arg
- freeContexts := arg!
Item was removed:
- ----- Method: ObjectMemory>>freeLargeContexts: (in category 'accessing') -----
- freeLargeContexts: arg
- freeLargeContexts := arg!
Item was removed:
- ----- Method: ObjectMemory>>gcBiasToGrow: (in category 'accessing') -----
- gcBiasToGrow: arg
- gcBiasToGrow := arg!
Item was removed:
- ----- Method: ObjectMemory>>gcSemaphoreIndex (in category 'accessing') -----
- gcSemaphoreIndex
- ^gcSemaphoreIndex!
Item was removed:
- ----- Method: ObjectMemory>>gcSemaphoreIndex: (in category 'accessing') -----
- gcSemaphoreIndex: index
- gcSemaphoreIndex := index!
Item was added:
+ ----- Method: ObjectMemory>>getAllocationsBetweenGCs (in category 'accessing') -----
+ getAllocationsBetweenGCs
+ ^allocationsBetweenGCs!
Item was added:
+ ----- Method: ObjectMemory>>getEndOfMemory (in category 'accessing') -----
+ getEndOfMemory
+ <returnTypeC: #usqInt>
+ ^endOfMemory!
Item was added:
+ ----- Method: ObjectMemory>>getFalseObj (in category 'accessing') -----
+ getFalseObj
+ ^falseObj!
Item was added:
+ ----- Method: ObjectMemory>>getFreeBlock (in category 'accessing') -----
+ getFreeBlock
+ <returnTypeC: #usqInt>
+ ^freeBlock!
Item was added:
+ ----- Method: ObjectMemory>>getFreeContexts (in category 'accessing') -----
+ getFreeContexts
+ ^freeContexts!
Item was added:
+ ----- Method: ObjectMemory>>getGcSemaphoreIndex (in category 'accessing') -----
+ getGcSemaphoreIndex
+ ^gcSemaphoreIndex!
Item was added:
+ ----- Method: ObjectMemory>>getGrowHeadroom (in category 'accessing') -----
+ getGrowHeadroom
+ ^growHeadroom!
Item was added:
+ ----- Method: ObjectMemory>>getLastHash (in category 'accessing') -----
+ getLastHash
+ "Simulation support"
+ ^lastHash!
Item was added:
+ ----- Method: ObjectMemory>>getMemory (in category 'accessing') -----
+ getMemory
+ <returnTypeC: #usqInt>
+ ^memory!
Item was added:
+ ----- Method: ObjectMemory>>getMemoryLimit (in category 'accessing') -----
+ getMemoryLimit
+ "Simulation support"
+ <returnTypeC: #usqInt>
+ ^memoryLimit!
Item was added:
+ ----- Method: ObjectMemory>>getNilObj (in category 'accessing') -----
+ getNilObj
+ ^nilObj!
Item was added:
+ ----- Method: ObjectMemory>>getRemapBufferCount (in category 'accessing') -----
+ getRemapBufferCount
+ ^remapBufferCount!
Item was added:
+ ----- Method: ObjectMemory>>getRootTableCount (in category 'accessing') -----
+ getRootTableCount
+ ^rootTableCount!
Item was added:
+ ----- Method: ObjectMemory>>getShrinkThreshold (in category 'accessing') -----
+ getShrinkThreshold
+ <returnTypeC: #usqInt>
+ ^shrinkThreshold!
Item was added:
+ ----- Method: ObjectMemory>>getSignalLowSpace (in category 'accessing') -----
+ getSignalLowSpace
+ ^signalLowSpace!
Item was added:
+ ----- Method: ObjectMemory>>getSpecialObjectsOop (in category 'accessing') -----
+ getSpecialObjectsOop
+ "Simulation support"
+ ^specialObjectsOop!
Item was added:
+ ----- Method: ObjectMemory>>getStatAllocationCount (in category 'accessing') -----
+ getStatAllocationCount
+ ^statAllocationCount!
Item was added:
+ ----- Method: ObjectMemory>>getStatCompMoveCount (in category 'accessing') -----
+ getStatCompMoveCount
+ ^statCompMoveCount!
Item was added:
+ ----- Method: ObjectMemory>>getStatFullGCMSecs (in category 'accessing') -----
+ getStatFullGCMSecs
+ ^statFullGCMSecs!
Item was added:
+ ----- Method: ObjectMemory>>getStatFullGCs (in category 'accessing') -----
+ getStatFullGCs
+ ^statFullGCs!
Item was added:
+ ----- Method: ObjectMemory>>getStatGCTime (in category 'accessing') -----
+ getStatGCTime
+ ^statGCTime!
Item was added:
+ ----- Method: ObjectMemory>>getStatGrowMemory (in category 'accessing') -----
+ getStatGrowMemory
+ ^statGrowMemory!
Item was added:
+ ----- Method: ObjectMemory>>getStatIGCDeltaTime (in category 'accessing') -----
+ getStatIGCDeltaTime
+ ^statIGCDeltaTime!
Item was added:
+ ----- Method: ObjectMemory>>getStatIncrGCMSecs (in category 'accessing') -----
+ getStatIncrGCMSecs
+ ^statIncrGCMSecs!
Item was added:
+ ----- Method: ObjectMemory>>getStatIncrGCs (in category 'accessing') -----
+ getStatIncrGCs
+ ^statIncrGCs!
Item was added:
+ ----- Method: ObjectMemory>>getStatMarkCount (in category 'accessing') -----
+ getStatMarkCount
+ ^statMarkCount!
Item was added:
+ ----- Method: ObjectMemory>>getStatMkFwdCount (in category 'accessing') -----
+ getStatMkFwdCount
+ ^statMkFwdCount!
Item was added:
+ ----- Method: ObjectMemory>>getStatRootTableCount (in category 'accessing') -----
+ getStatRootTableCount
+ ^statRootTableCount!
Item was added:
+ ----- Method: ObjectMemory>>getStatRootTableOverflows (in category 'accessing') -----
+ getStatRootTableOverflows
+ ^statRootTableOverflows!
Item was added:
+ ----- Method: ObjectMemory>>getStatShrinkMemory (in category 'accessing') -----
+ getStatShrinkMemory
+ ^statShrinkMemory!
Item was added:
+ ----- Method: ObjectMemory>>getStatSpecialMarkCount (in category 'accessing') -----
+ getStatSpecialMarkCount
+ ^statSpecialMarkCount!
Item was added:
+ ----- Method: ObjectMemory>>getStatSurvivorCount (in category 'accessing') -----
+ getStatSurvivorCount
+ ^statSurvivorCount!
Item was added:
+ ----- Method: ObjectMemory>>getStatSweepCount (in category 'accessing') -----
+ getStatSweepCount
+ ^statSweepCount!
Item was added:
+ ----- Method: ObjectMemory>>getStatTenures (in category 'accessing') -----
+ getStatTenures
+ ^statTenures!
Item was added:
+ ----- Method: ObjectMemory>>getStatpendingFinalizationSignals (in category 'accessing') -----
+ getStatpendingFinalizationSignals
+ ^statpendingFinalizationSignals!
Item was added:
+ ----- Method: ObjectMemory>>getTenuringThreshold (in category 'accessing') -----
+ getTenuringThreshold
+ ^tenuringThreshold!
Item was added:
+ ----- Method: ObjectMemory>>getTrueObj (in category 'accessing') -----
+ getTrueObj
+ ^trueObj!
Item was added:
+ ----- Method: ObjectMemory>>getYoungStart (in category 'accessing') -----
+ getYoungStart
+ <returnTypeC: #usqInt>
+ self subclassResponsibility!
Item was removed:
- ----- Method: ObjectMemory>>growHeadroom (in category 'accessing') -----
- growHeadroom
- ^growHeadroom!
Item was removed:
- ----- Method: ObjectMemory>>growHeadroom: (in category 'accessing') -----
- growHeadroom: arg
- growHeadroom := arg!
Item was removed:
- ----- Method: ObjectMemory>>headerTypeBytes (in category 'accessing') -----
- headerTypeBytes
- ^headerTypeBytes!
Item was removed:
- ----- Method: ObjectMemory>>headerTypeBytes: (in category 'accessing') -----
- headerTypeBytes: array
- "Simulation support"
- headerTypeBytes := array!
Item was added:
+ ----- Method: ObjectMemory>>headerTypeBytesAt:put: (in category 'accessing') -----
+ headerTypeBytesAt: index put: value
+ headerTypeBytes at: index put: value!
Item was removed:
- ----- Method: ObjectMemory>>headerTypeClass (in category 'accessing') -----
- headerTypeClass
- ^HeaderTypeClass!
Item was added:
+ ----- Method: ObjectMemory>>heapMapAtWord: (in category 'debug printing') -----
+ heapMapAtWord: wordPointer
+ "Implemented in support code for Cog branch in Cross/vm/sqHeapMap.c and
+ stubbed out here for use with trunk platform sources"
+
+ self flag: #FIXME. "remove this method and add sqHeapMap.c to Cross when 64 bit address space can be supported"
+ ^ 1
+
+ "
+ /*
+ * Answer non-zero if the heapMap is set at wordPointer, 0 otherwise
+ */
+ int heapMapAtWord(void *wordPointer)
+ { . . . }
+ "!
Item was added:
+ ----- Method: ObjectMemory>>indexablePointersFormat (in category 'header formats') -----
+ indexablePointersFormat
+ <api>
+ ^3!
Item was removed:
- ----- Method: ObjectMemory>>interpreter: (in category 'accessing') -----
- interpreter: anInterpreter
- interpreter := anInterpreter!
Item was added:
+ ----- Method: ObjectMemory>>isYoungRootHeader: (in category 'garbage collection') -----
+ isYoungRootHeader: header
+ "Answer if oop is a root for objects in youngSpace"
+ ^(header bitAnd: self rootBit) ~= 0!
Item was removed:
- ----- Method: ObjectMemory>>lastHash (in category 'accessing') -----
- lastHash
- "Simulation support"
- ^lastHash!
Item was removed:
- ----- Method: ObjectMemory>>lastHash: (in category 'accessing') -----
- lastHash: hash
- "Simulation support"
- lastHash := hash!
Item was added:
+ ----- Method: ObjectMemory>>lastPointerFormat (in category 'header access') -----
+ lastPointerFormat
+ "N.B. 5 is unused and could be used for ephemerons.
+ 7 is unused and could be used for 64-bit indexable."
+ ^4!
Item was removed:
- ----- Method: ObjectMemory>>lowSpaceThreshold: (in category 'accessing') -----
- lowSpaceThreshold: arg
- lowSpaceThreshold := arg!
Item was removed:
- ----- Method: ObjectMemory>>memory (in category 'accessing') -----
- memory
- ^memory!
Item was removed:
- ----- Method: ObjectMemory>>memory: (in category 'accessing') -----
- memory: loc
- memory := loc!
Item was removed:
- ----- Method: ObjectMemory>>memoryLimit (in category 'accessing') -----
- memoryLimit
- "Simulation support"
- ^memoryLimit!
Item was removed:
- ----- Method: ObjectMemory>>memoryLimit: (in category 'accessing') -----
- memoryLimit: limit
- "Simulation support"
- memoryLimit := limit!
Item was removed:
- ----- Method: ObjectMemory>>nilObj (in category 'accessing') -----
- nilObj
- ^nilObj!
Item was removed:
- ----- Method: ObjectMemory>>nilObj: (in category 'accessing') -----
- nilObj: oop
- nilObj := oop!
Item was removed:
- ----- Method: ObjectMemory>>remapBuffer (in category 'accessing') -----
- remapBuffer
- ^remapBuffer!
Item was removed:
- ----- Method: ObjectMemory>>remapBuffer: (in category 'accessing') -----
- remapBuffer: table
- "Simulation support"
- remapBuffer := table!
Item was added:
+ ----- Method: ObjectMemory>>remapBufferAt: (in category 'accessing') -----
+ remapBufferAt: index
+ ^remapBuffer at: index!
Item was added:
+ ----- Method: ObjectMemory>>remapBufferAt:put: (in category 'accessing') -----
+ remapBufferAt: index put: value
+ remapBuffer at: index put: value!
Item was removed:
- ----- Method: ObjectMemory>>remapBufferCount (in category 'accessing') -----
- remapBufferCount
- ^remapBufferCount!
Item was removed:
- ----- Method: ObjectMemory>>rootTable (in category 'accessing') -----
- rootTable
- ^rootTable!
Item was removed:
- ----- Method: ObjectMemory>>rootTable: (in category 'accessing') -----
- rootTable: table
- "Simulation support"
- rootTable := table!
Item was added:
+ ----- Method: ObjectMemory>>rootTableAt: (in category 'accessing') -----
+ rootTableAt: index
+ ^rootTable at: index!
Item was removed:
- ----- Method: ObjectMemory>>rootTableCount (in category 'accessing') -----
- rootTableCount
- ^rootTableCount!
Item was added:
+ ----- Method: ObjectMemory>>setAllocationsBetweenGCs: (in category 'accessing') -----
+ setAllocationsBetweenGCs: count
+ allocationsBetweenGCs := count!
Item was changed:
+ ----- Method: ObjectMemory>>setEndOfMemory: (in category 'accessing') -----
+ setEndOfMemory: position
+ "Simulation support"
+ endOfMemory := position!
- ----- Method: ObjectMemory>>setEndOfMemory: (in category 'initialization') -----
- setEndOfMemory: newEndOfMemory
- self assert: (newEndOfMemory bitAnd: self bytesPerWord - 1) = 0.
- endOfMemory := newEndOfMemory!
Item was added:
+ ----- Method: ObjectMemory>>setForceTenureFlag: (in category 'accessing') -----
+ setForceTenureFlag: arg
+ forceTenureFlag := arg!
Item was added:
+ ----- Method: ObjectMemory>>setFreeContexts: (in category 'accessing') -----
+ setFreeContexts: arg
+ freeContexts := arg!
Item was added:
+ ----- Method: ObjectMemory>>setFreeLargeContexts: (in category 'accessing') -----
+ setFreeLargeContexts: arg
+ freeLargeContexts := arg!
Item was added:
+ ----- Method: ObjectMemory>>setGcBiasToGrow: (in category 'accessing') -----
+ setGcBiasToGrow: arg
+ gcBiasToGrow := arg!
Item was added:
+ ----- Method: ObjectMemory>>setGcSemaphoreIndex: (in category 'accessing') -----
+ setGcSemaphoreIndex: index
+ gcSemaphoreIndex := index!
Item was added:
+ ----- Method: ObjectMemory>>setGrowHeadroom: (in category 'accessing') -----
+ setGrowHeadroom: arg
+ growHeadroom := arg!
Item was added:
+ ----- Method: ObjectMemory>>setLastHash: (in category 'accessing') -----
+ setLastHash: hash
+ "Simulation support"
+ lastHash := hash!
Item was added:
+ ----- Method: ObjectMemory>>setLowSpaceThreshold: (in category 'accessing') -----
+ setLowSpaceThreshold: arg
+ lowSpaceThreshold := arg!
Item was added:
+ ----- Method: ObjectMemory>>setMemory: (in category 'accessing') -----
+ setMemory: loc
+ memory := loc!
Item was changed:
+ ----- Method: ObjectMemory>>setMemoryLimit: (in category 'accessing') -----
+ setMemoryLimit: limit
+ "Simulation support"
+ memoryLimit := limit!
- ----- Method: ObjectMemory>>setMemoryLimit: (in category 'initialization') -----
- setMemoryLimit: newMemoryLimit
- self assert: (newMemoryLimit bitAnd: self bytesPerWord - 1) = 0.
- memoryLimit := newMemoryLimit!
Item was added:
+ ----- Method: ObjectMemory>>setShrinkThreshold: (in category 'accessing') -----
+ setShrinkThreshold: arg
+ shrinkThreshold := arg!
Item was added:
+ ----- Method: ObjectMemory>>setSignalLowSpace: (in category 'accessing') -----
+ setSignalLowSpace: boolean
+ signalLowSpace := boolean!
Item was added:
+ ----- Method: ObjectMemory>>setSpecialObjectsOop: (in category 'accessing') -----
+ setSpecialObjectsOop: oop
+ "Simulation support"
+ specialObjectsOop := oop!
Item was added:
+ ----- Method: ObjectMemory>>setStatpendingFinalizationSignals: (in category 'accessing') -----
+ setStatpendingFinalizationSignals: arg
+ statpendingFinalizationSignals := arg!
Item was added:
+ ----- Method: ObjectMemory>>setTenuringThreshold: (in category 'accessing') -----
+ setTenuringThreshold: arg
+ tenuringThreshold := arg!
Item was added:
+ ----- Method: ObjectMemory>>setYoungStart: (in category 'accessing') -----
+ setYoungStart: arg
+ youngStart := arg!
Item was removed:
- ----- Method: ObjectMemory>>shrinkThreshold (in category 'accessing') -----
- shrinkThreshold
- ^shrinkThreshold!
Item was removed:
- ----- Method: ObjectMemory>>shrinkThreshold: (in category 'accessing') -----
- shrinkThreshold: arg
- shrinkThreshold := arg!
Item was removed:
- ----- Method: ObjectMemory>>signalLowSpace (in category 'accessing') -----
- signalLowSpace
- ^signalLowSpace!
Item was removed:
- ----- Method: ObjectMemory>>signalLowSpace: (in category 'accessing') -----
- signalLowSpace: boolean
- signalLowSpace := boolean!
Item was removed:
- ----- Method: ObjectMemory>>specialObjectsOop (in category 'accessing') -----
- specialObjectsOop
- "Simulation support"
- ^specialObjectsOop!
Item was removed:
- ----- Method: ObjectMemory>>specialObjectsOop: (in category 'accessing') -----
- specialObjectsOop: oop
- "Simulation support"
- specialObjectsOop := oop!
Item was added:
+ ----- Method: ObjectMemory>>startOfFreeSpace (in category 'accessing') -----
+ startOfFreeSpace
+ <returnTypeC: #usqInt>
+ self subclassResponsibility!
Item was removed:
- ----- Method: ObjectMemory>>statAllocationCount (in category 'accessing') -----
- statAllocationCount
- ^statAllocationCount!
Item was removed:
- ----- Method: ObjectMemory>>statCompMoveCount (in category 'accessing') -----
- statCompMoveCount
- ^statCompMoveCount!
Item was removed:
- ----- Method: ObjectMemory>>statFullGCMSecs (in category 'accessing') -----
- statFullGCMSecs
- ^statFullGCMSecs!
Item was removed:
- ----- Method: ObjectMemory>>statFullGCs (in category 'accessing') -----
- statFullGCs
- ^statFullGCs!
Item was removed:
- ----- Method: ObjectMemory>>statGCTime (in category 'accessing') -----
- statGCTime
- ^statGCTime!
Item was removed:
- ----- Method: ObjectMemory>>statGrowMemory (in category 'accessing') -----
- statGrowMemory
- ^statGrowMemory!
Item was removed:
- ----- Method: ObjectMemory>>statIGCDeltaTime (in category 'accessing') -----
- statIGCDeltaTime
- ^statIGCDeltaTime!
Item was removed:
- ----- Method: ObjectMemory>>statIncrGCMSecs (in category 'accessing') -----
- statIncrGCMSecs
- ^statIncrGCMSecs!
Item was removed:
- ----- Method: ObjectMemory>>statIncrGCs (in category 'accessing') -----
- statIncrGCs
- ^statIncrGCs!
Item was removed:
- ----- Method: ObjectMemory>>statMarkCount (in category 'accessing') -----
- statMarkCount
- ^statMarkCount!
Item was removed:
- ----- Method: ObjectMemory>>statMkFwdCount (in category 'accessing') -----
- statMkFwdCount
- ^statMkFwdCount!
Item was removed:
- ----- Method: ObjectMemory>>statRootTableCount (in category 'accessing') -----
- statRootTableCount
- ^statRootTableCount!
Item was removed:
- ----- Method: ObjectMemory>>statRootTableOverflows (in category 'accessing') -----
- statRootTableOverflows
- ^statRootTableOverflows!
Item was removed:
- ----- Method: ObjectMemory>>statShrinkMemory (in category 'accessing') -----
- statShrinkMemory
- ^statShrinkMemory!
Item was removed:
- ----- Method: ObjectMemory>>statSpecialMarkCount (in category 'accessing') -----
- statSpecialMarkCount
- ^statSpecialMarkCount!
Item was removed:
- ----- Method: ObjectMemory>>statSurvivorCount (in category 'accessing') -----
- statSurvivorCount
- ^statSurvivorCount!
Item was removed:
- ----- Method: ObjectMemory>>statSweepCount (in category 'accessing') -----
- statSweepCount
- ^statSweepCount!
Item was removed:
- ----- Method: ObjectMemory>>statTenures (in category 'accessing') -----
- statTenures
- ^statTenures!
Item was removed:
- ----- Method: ObjectMemory>>statpendingFinalizationSignals (in category 'accessing') -----
- statpendingFinalizationSignals
- ^statpendingFinalizationSignals!
Item was removed:
- ----- Method: ObjectMemory>>statpendingFinalizationSignals: (in category 'accessing') -----
- statpendingFinalizationSignals: arg
- statpendingFinalizationSignals := arg!
Item was removed:
- ----- Method: ObjectMemory>>tenuringThreshold (in category 'accessing') -----
- tenuringThreshold
- ^tenuringThreshold!
Item was removed:
- ----- Method: ObjectMemory>>tenuringThreshold: (in category 'accessing') -----
- tenuringThreshold: arg
- tenuringThreshold := arg!
Item was removed:
- ----- Method: ObjectMemory>>trueObj (in category 'accessing') -----
- trueObj
- ^trueObj!
Item was removed:
- ----- Method: ObjectMemory>>trueObj: (in category 'accessing') -----
- trueObj: oop
- trueObj := oop!
Item was removed:
- ----- Method: ObjectMemory>>weakRoots: (in category 'accessing') -----
- weakRoots: table
- "Simulation support"
- weakRoots := table!
Item was removed:
- ----- Method: ObjectMemory>>youngStart (in category 'accessing') -----
- youngStart
- self subclassResponsibility!
Item was removed:
- ----- Method: ObjectMemory>>youngStart: (in category 'accessing') -----
- youngStart: arg
- youngStart := arg!
Item was changed:
----- Method: ObjectMemorySimulator>>allObjectsDo: (in category 'debug support') -----
allObjectsDo: objBlock
| oop |
oop := self firstObject.
+ [oop < self getEndOfMemory] whileTrue:
- [oop < self endOfMemory] whileTrue:
[(self isFreeObject: oop)
ifFalse: [objBlock value: oop].
oop := self objectAfter: oop].
!
Item was changed:
----- Method: ObjectMemorySimulator>>allObjectsSelect: (in category 'debug support') -----
allObjectsSelect: objBlock
"self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]"
| oop selected |
oop := self firstObject.
selected := OrderedCollection new.
+ [oop < self getEndOfMemory] whileTrue:
- [oop < self endOfMemory] whileTrue:
[(self isFreeObject: oop)
ifFalse: [(objBlock value: oop) ifTrue: [selected addLast: oop]].
oop := self objectAfter: oop].
^ selected!
Item was changed:
----- Method: ObjectMemorySimulator>>numObjects (in category 'debug support') -----
numObjects
| count oop |
count := 0.
oop := self firstObject.
+ [oop < self getEndOfMemory] whileTrue:
- [oop < self endOfMemory] whileTrue:
[(self isFreeObject: oop)
ifFalse: [count := count + 1].
oop := self objectAfter: oop].
^count
!
Item was added:
+ ----- Method: ObjectMemorySimulator>>setHeaderTypeBytes: (in category 'initialization') -----
+ setHeaderTypeBytes: array
+ headerTypeBytes := array!
Item was added:
+ ----- Method: ObjectMemorySimulator>>setInterpreter: (in category 'initialization') -----
+ setInterpreter: anInterpreter
+ interpreter := anInterpreter!
Item was added:
+ ----- Method: ObjectMemorySimulator>>setRemapBuffer: (in category 'initialization') -----
+ setRemapBuffer: table
+ remapBuffer := table!
Item was added:
+ ----- Method: ObjectMemorySimulator>>setRootTable: (in category 'initialization') -----
+ setRootTable: table
+ rootTable := table!
Item was added:
+ ----- Method: ObjectMemorySimulator>>setWeakRoots: (in category 'initialization') -----
+ setWeakRoots: table
+ weakRoots := table!
Item was changed:
----- Method: SlangTestSupportInterpreter>>setInstanceVariableWithAnAccessorMethod (in category 'local and instance vars') -----
setInstanceVariableWithAnAccessorMethod
+ objectMemory setAVariable: (objectMemory remap: objectMemory getNilObj).
- objectMemory setAVariable: (objectMemory remap: objectMemory nilObj).
!
Item was changed:
----- Method: SlangTestSupportPlugin>>methodWithLoopLimitThatIsNotModified: (in category 'loop limits') -----
methodWithLoopLimitThatIsNotModified: arrayObj
+ 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: 0]
- 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]
!
Item was changed:
----- Method: SlangTestSupportSSIP>>methodWithLoopLimitThatIsNotModified: (in category 'loop limits') -----
methodWithLoopLimitThatIsNotModified: arrayObj
+ 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: 0]
- 0 to: 10 do: [:i | self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]
!
Item was changed:
----- Method: StackInterpreter>>checkForEventsMayContextSwitch: (in category 'process primitive support') -----
checkForEventsMayContextSwitch: mayContextSwitch
"Check for possible interrupts and handle one if necessary.
Answer if a context switch has occurred."
| switched sema now |
<inline: false>
<var: #now type: #usqLong>
statCheckForEvents := statCheckForEvents + 1.
"restore the stackLimit if it has been smashed."
self restoreStackLimit.
self externalWriteBackHeadFramePointers.
self assert: stackPage = stackPages mostRecentlyUsedPage.
"Allow the platform to do anything it needs to do synchronously."
self ioSynchronousCheckForEvents.
self checkCogCompiledCodeCompactionCalledFor.
objectMemory needGCFlag ifTrue:
+ [objectMemory setNeedGCFlag: false.
- [objectMemory needGCFlag: false.
"sufficientSpaceAfterGC: runs the incremental GC and
then, if not enough space is available, the fullGC."
(objectMemory sufficientSpaceAfterGC: 0) ifFalse:
[self setSignalLowSpaceFlagAndSaveProcess]].
mayContextSwitch ifFalse: [^false].
switched := false.
(profileProcess ~= objectMemory nilObject
or: [nextProfileTick > 0 and:[self ioHighResClock >= nextProfileTick]]) ifTrue:
["Take a sample (if not already done so) for the profiler if it is active. This
must be done before any of the synchronousSignals below or else we will
attribute a pause in ioRelinquishProcessor to the newly activated process."
profileProcess = objectMemory nilObject ifTrue:
[profileProcess := self activeProcess.
profileMethod := objectMemory nilObject].
"and signal the profiler semaphore if it is present"
(profileSemaphore ~= objectMemory nilObject
and: [self synchronousSignal: profileSemaphore]) ifTrue:
[switched := true].
nextProfileTick := 0].
self checkDeliveryOfLongRunningPrimitiveSignal ifTrue:
[switched := true].
+ objectMemory getSignalLowSpace ifTrue:
+ [objectMemory setSignalLowSpace: false. "reset flag"
- objectMemory signalLowSpace ifTrue:
- [objectMemory signalLowSpace: false. "reset flag"
sema := objectMemory splObj: TheLowSpaceSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
"inIOProcessEvents prevents reentrancy into ioProcessEvents and allows disabling
ioProcessEvents e.g. for native GUIs. We would like to manage that here but can't
since the platform code may choose to call ioProcessEvents itself in various places."
false
ifTrue:
[((now := self ioUTCMicroseconds) >= nextPollUsecs
and: [inIOProcessEvents = 0]) ifTrue:
[statIOProcessEvents := statIOProcessEvents + 1.
inIOProcessEvents := inIOProcessEvents + 1.
self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
inIOProcessEvents > 0 ifTrue:
[inIOProcessEvents := inIOProcessEvents - 1].
nextPollUsecs := now + 20000
"msecs to wait before next call to ioProcessEvents. Note that strictly
speaking we might need to update 'now' at this point since
ioProcessEvents could take a very long time on some platforms"]]
ifFalse:
[(now := self ioUTCMicroseconds) >= nextPollUsecs ifTrue:
[statIOProcessEvents := statIOProcessEvents + 1.
self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
nextPollUsecs := now + 20000
"msecs to wait before next call to ioProcessEvents. Note that strictly
speaking we might need to update 'now' at this point since
ioProcessEvents could take a very long time on some platforms"]].
interruptPending ifTrue:
[interruptPending := false.
"reset interrupt flag"
sema := objectMemory splObj: TheInterruptSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
nextWakeupUsecs ~= 0 ifTrue:
[now >= nextWakeupUsecs ifTrue:
[nextWakeupUsecs := 0.
"set timer interrupt to 0 for 'no timer'"
sema := objectMemory splObj: TheTimerSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]]].
"signal any pending finalizations"
pendingFinalizationSignals > 0 ifTrue:
[sema := objectMemory splObj: TheFinalizationSemaphore.
((objectMemory isClassOfNonImm: sema equalTo: (objectMemory splObj: ClassSemaphore))
and: [self synchronousSignal: sema]) ifTrue:
[switched := true].
pendingFinalizationSignals := 0].
"signal all semaphores in semaphoresToSignal"
self signalExternalSemaphores ifTrue:
[switched := true].
^switched!
Item was changed:
----- Method: StackInterpreter>>checkInterpreterIntegrity (in category 'object memory support') -----
checkInterpreterIntegrity
"Perform an integrity/leak check using the heapMap. Assume
clearLeakMapAndMapAccessibleObjects has set a bit at each
object's header. Check that all oops in the interpreter's state
points to a header. Answer if all checks pass."
| ok |
ok := true.
+ (objectMemory checkOopIntegrity: objectMemory getSpecialObjectsOop named: 'specialObjectsOop')ifFalse:
- (objectMemory checkOopIntegrity: objectMemory specialObjectsOop named: 'specialObjectsOop')ifFalse:
[ok := false].
(objectMemory isIntegerObject: messageSelector) ifFalse:
[(objectMemory checkOopIntegrity: messageSelector named: 'messageSelector')ifFalse:
[ok := false]].
(objectMemory checkOopIntegrity: newMethod named: 'newMethod')ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: lkupClass named: 'lkupClass')ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: profileProcess named: 'profileProcess')ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: profileMethod named: 'profileMethod')ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: profileSemaphore named: 'profileSemaphore')ifFalse:
[ok := false].
tempOop = 0 ifFalse:
[(objectMemory checkOopIntegrity: tempOop named: 'tempOop')ifFalse:
[ok := false]].
"Callback support - check suspended callback list"
1 to: jmpDepth do:
[:i|
(objectMemory checkOopIntegrity: (suspendedCallbacks at: i) named: 'suspendedCallbacks' index: i) ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: (suspendedMethods at: i) named: 'suspendedMethods' index: i) ifFalse:
[ok := false]].
self checkLogIntegrity ifFalse:
[ok := false].
^ok!
Item was changed:
----- Method: StackInterpreter>>dumpImage: (in category 'image save/restore') -----
dumpImage: fileName
"Dump the entire image out to the given file. Intended for debugging only."
| f dataSize result |
<export: true>
<var: #f type: 'sqImageFile'>
f := self cCode: 'sqImageFileOpen(pointerForOop(fileName), "wb")'.
f = nil ifTrue: [^-1].
+ dataSize := objectMemory getEndOfMemory - objectMemory startOfMemory.
- dataSize := objectMemory endOfMemory - objectMemory startOfMemory.
result := self cCode: 'sqImageFileWrite(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
self cCode: 'sqImageFileClose(f)'.
^result
!
Item was changed:
----- Method: StackInterpreter>>ensureImageFormatIsUpToDate: (in category 'image save/restore') -----
ensureImageFormatIsUpToDate: swapBytes
"Ensure the image data has been updayed to suit the current VM."
<inline: false>
swapBytes
ifTrue: [self reverseBytesInImage]
+ ifFalse: [self convertFloatsToPlatformOrderFrom: objectMemory firstObject to: objectMemory getEndOfMemory]!
- ifFalse: [self convertFloatsToPlatformOrderFrom: objectMemory firstObject to: objectMemory endOfMemory]!
Item was changed:
----- Method: StackInterpreter>>mapInterpreterOops (in category 'object memory support') -----
mapInterpreterOops
"Map all oops in the interpreter's state to their new values
during garbage collection or a become: operation."
"Assume: All traced variables contain valid oops."
| oop |
objectMemory nilObject: (objectMemory remap: objectMemory nilObject).
+ objectMemory setFalseObject: (objectMemory remap: objectMemory falseObject).
+ objectMemory setTrueObject: (objectMemory remap: objectMemory trueObject).
+ objectMemory setSpecialObjectsOop: (objectMemory remap: objectMemory getSpecialObjectsOop).
- objectMemory falseObject: (objectMemory remap: objectMemory falseObject).
- objectMemory trueObject: (objectMemory remap: objectMemory trueObject).
- objectMemory specialObjectsOop: (objectMemory remap: objectMemory specialObjectsOop).
self mapStackPages.
self mapMachineCode.
self mapTraceLogs.
self mapVMRegisters.
self mapProfileState.
tempOop = 0 ifFalse: [tempOop := self remap: tempOop].
+ 1 to: objectMemory getRemapBufferCount do: [:i |
+ oop := objectMemory remapBufferAt: i.
- 1 to: objectMemory remapBufferCount do: [:i |
- oop := objectMemory remapBuffer at: i.
(objectMemory isIntegerObject: oop)
+ ifFalse: [objectMemory remapBufferAt: i put: (objectMemory remap: oop)]].
- ifFalse: [objectMemory remapBuffer at: i put: (objectMemory remap: oop)]].
"Callback support - trace suspended callback list"
1 to: jmpDepth do:[:i|
oop := suspendedCallbacks at: i.
(objectMemory isIntegerObject: oop)
ifFalse:[suspendedCallbacks at: i put: (objectMemory remap: oop)].
oop := suspendedMethods at: i.
(objectMemory isIntegerObject: oop)
ifFalse:[suspendedMethods at: i put: (objectMemory remap: oop)].
].
!
Item was changed:
----- Method: StackInterpreter>>markAndTraceInterpreterOops: (in category 'object memory support') -----
markAndTraceInterpreterOops: fullGCFlag
"Mark and trace all oops in the interpreter's state."
"Assume: All traced variables contain valid oops."
| oop |
"Must mark stack pages first to initialize the per-page trace
flags for full garbage collect before any subsequent tracing."
self markAndTraceStackPages: fullGCFlag.
self markAndTraceTraceLog.
self markAndTracePrimTraceLog.
+ objectMemory markAndTrace: objectMemory getSpecialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
- objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
(objectMemory isIntegerObject: messageSelector) ifFalse:
[objectMemory markAndTrace: messageSelector].
(objectMemory isIntegerObject: newMethod) ifFalse:
[objectMemory markAndTrace: newMethod.
objectMemory markAndTrace: lkupClass].
self traceProfileState.
tempOop = 0 ifFalse: [self markAndTrace: tempOop].
+ 1 to: objectMemory getRemapBufferCount do: [:i |
+ oop := objectMemory remapBufferAt: i.
- 1 to: objectMemory remapBufferCount do: [:i |
- oop := objectMemory remapBuffer at: i.
(objectMemory isIntegerObject: oop) ifFalse: [objectMemory markAndTrace: oop]].
"Callback support - trace suspended callback list"
1 to: jmpDepth do:[:i|
oop := suspendedCallbacks at: i.
(objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
oop := suspendedMethods at: i.
(objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
]!
Item was changed:
----- Method: StackInterpreter>>okayInterpreterObjects (in category 'debug support') -----
okayInterpreterObjects
| oopOrZero oop |
self okayFields: objectMemory nilObject.
self okayFields: objectMemory falseObject.
self okayFields: objectMemory trueObject.
+ self okayFields: objectMemory getSpecialObjectsOop.
- self okayFields: objectMemory specialObjectsOop.
self okayFields: messageSelector.
self okayFields: newMethod.
self okayFields: lkupClass.
0 to: MethodCacheEntries - 1 by: MethodCacheEntrySize do: [ :i |
oopOrZero := methodCache at: i + MethodCacheSelector.
oopOrZero = 0 ifFalse: [
self okayFields: (methodCache at: i + MethodCacheSelector).
self okayFields: (methodCache at: i + MethodCacheClass).
self okayFields: (methodCache at: i + MethodCacheMethod).
].
].
+ 1 to: objectMemory getRemapBufferCount do: [ :i |
+ oop := objectMemory remapBufferAt: i.
- 1 to: objectMemory remapBufferCount do: [ :i |
- oop := objectMemory remapBuffer at: i.
(objectMemory isIntegerObject: oop) ifFalse: [
self okayFields: oop.
].
].
self okayStackZone.!
Item was changed:
----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr hdrNumStackPages
minimumMemory memStart bytesRead bytesToShift heapSize hdrEdenBytes
headerFlags hdrMaxExtSemTabSize |
<var: #f type: 'sqImageFile '>
<var: #memStart type: 'usqInt'>
<var: #desiredHeapSize type: 'usqInt'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #dataSize type: 'size_t '>
<var: #imageOffset type: 'squeakFileOffsetType '>
metaclassSizeBytes := 6 * self bytesPerWord. "guess (Metaclass instSize * BPW)"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - self bytesPerWord. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
+ objectMemory setSpecialObjectsOop: (self getLongFromFile: f swap: swapBytes).
+ objectMemory setLastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
- objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
- objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
savedWindowSize := self getLongFromFile: f swap: swapBytes.
headerFlags := self getLongFromFile: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self getLongFromFile: f swap: swapBytes.
hdrNumStackPages := self getShortFromFile: f swap: swapBytes.
"4 stack pages is small. Should be able to run with as few as
three. 4 should be comfortable but slow. 8 is a reasonable
default. Can be changed via vmParameterAt: 43 put: n.
Can be set as a preference (Info.plist, VM.ini, command line etc).
If desiredNumStackPages is already non-zero then it has been
set as a preference. Ignore (but preserve) the header's default."
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
"pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
Preserve it to be polite to images run on Cog."
theUnknownShort := self getShortFromFile: f swap: swapBytes.
hdrEdenBytes := self getLongFromFile: f swap: swapBytes.
+ objectMemory setEdenBytes: (desiredEdenBytes ~= 0
- objectMemory edenBytes: (desiredEdenBytes ~= 0
ifTrue: [desiredEdenBytes]
ifFalse:
[hdrEdenBytes = 0
ifTrue: [objectMemory defaultEdenBytes]
ifFalse: [hdrEdenBytes]]).
desiredEdenBytes := hdrEdenBytes.
hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
hdrMaxExtSemTabSize ~= 0 ifTrue:
[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
"decrease Squeak object heap to leave extra memory for the VM"
heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
"compare memory requirements with availability".
minimumMemory := dataSize + objectMemory edenBytes + self interpreterAllocationReserveBytes.
heapSize < minimumMemory ifTrue:
[self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap"
+ objectMemory setMemory: (self cCode: 'sqAllocateMemory(minimumMemory, heapSize)').
+ objectMemory getMemory = nil ifTrue: [self insufficientMemoryAvailableError].
- objectMemory memory: (self cCode: 'sqAllocateMemory(minimumMemory, heapSize)').
- objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
memStart := objectMemory startOfMemory.
objectMemory setMemoryLimit: (memStart + heapSize) - 24. "decrease memoryLimit a tad for safety"
objectMemory setEndOfMemory: memStart + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
bytesRead := self cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
self ensureImageFormatIsUpToDate: swapBytes.
"compute difference between old and new memory base addresses"
bytesToShift := memStart - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
^dataSize
!
Item was changed:
----- Method: StackInterpreter>>reverseBytesInImage (in category 'image save/restore') -----
reverseBytesInImage
"Byte-swap all words in memory after reading in the entire image file with bulk read. Contributed by Tim Rowledge."
"First, byte-swap every word in the image. This fixes objects headers."
+ objectMemory reverseBytesFrom: objectMemory startOfMemory to: objectMemory getEndOfMemory.
- objectMemory reverseBytesFrom: objectMemory startOfMemory to: objectMemory endOfMemory.
"Second, return the bytes of bytes-type objects to their orginal order, and perform any
other format conversions."
+ self updateObjectsPostByteSwapFrom: objectMemory firstObject to: objectMemory getEndOfMemory!
- self updateObjectsPostByteSwapFrom: objectMemory firstObject to: objectMemory endOfMemory!
Item was changed:
----- Method: StackInterpreter>>setSignalLowSpaceFlagAndSaveProcess (in category 'process primitive support') -----
setSignalLowSpaceFlagAndSaveProcess
"The low space semaphore is about to be signaled. Set the signalLowSpace flag,
and force an interrupt check. Save the currently active process in the special
objects array so that the low space handler will be able to determine the process
that first triggered a low space condition. The image's low space handler is expected
to nil out the special objects array slot when it handles the low space condition."
| lastSavedProcess activeProc |
<inline: false>
DumpStackOnLowSpace ~= 0 ifTrue:
[self printCallStack.
self printAllStacks].
+ objectMemory setSignalLowSpace: true.
+ objectMemory setLowSpaceThreshold: 0. "disable additional interrupts until lowSpaceThreshold is reset by image"
- objectMemory signalLowSpace: true.
- objectMemory lowSpaceThreshold: 0. "disable additional interrupts until lowSpaceThreshold is reset by image"
lastSavedProcess := objectMemory splObj: ProcessSignalingLowSpace.
lastSavedProcess = objectMemory nilObject ifTrue:
[activeProc := self activeProcess.
objectMemory splObj: ProcessSignalingLowSpace put: activeProc].
self forceInterruptCheck!
Item was changed:
----- Method: StackInterpreter>>storeAndPopReceiverVariableBytecode (in category 'stack bytecodes') -----
storeAndPopReceiverVariableBytecode
"Note: This code uses
storePointerUnchecked:ofObject:withValue: and does the
store check explicitely in order to help the translator
produce better code."
| rcvr top |
rcvr := self receiver.
top := self internalStackTop.
+ (self oop: rcvr isLessThan: objectMemory getYoungStart) ifTrue:
- (self oop: rcvr isLessThan: objectMemory youngStart) ifTrue:
[objectMemory possibleRootStoreInto: rcvr value: top].
objectMemory storePointerUnchecked: (currentBytecode bitAnd: 7) ofObject: rcvr withValue: top.
self fetchNextBytecode.
self internalPop: 1!
Item was changed:
----- Method: StackInterpreter>>writeImageFileIO: (in category 'image save/restore') -----
writeImageFileIO: imageBytes
| headerStart headerSize f bytesWritten sCWIfn okToWrite memStart |
<var: #f type: 'sqImageFile'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #sCWIfn type: 'void *'>
"If the security plugin can be loaded, use it to check for write permission.
If not, assume it's ok"
sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
sCWIfn ~= 0 ifTrue:
[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
okToWrite ifFalse:[^self primitiveFail]].
"local constants"
headerStart := 0.
headerSize := 64. "header size in bytes; do not change!!"
f := self cCode: 'sqImageFileOpen(imageName, "wb")'.
f = nil ifTrue: "could not open the image file for writing"
[^self primitiveFail].
headerStart := self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+imageBytes)'.
self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
"position file to start of header"
self sqImageFile: f Seek: headerStart.
self putLong: self imageFormatVersion toFile: f.
self putLong: headerSize toFile: f.
self putLong: imageBytes toFile: f.
self putLong: objectMemory startOfMemory toFile: f.
+ self putLong: objectMemory getSpecialObjectsOop toFile: f.
- self putLong: objectMemory specialObjectsOop toFile: f.
self putLong: objectMemory newObjectHash toFile: f.
self putLong: self ioScreenSize toFile: f.
self putLong: self getImageHeaderFlags toFile: f.
self putLong: extraVMMemory toFile: f.
self putShort: desiredNumStackPages toFile: f.
self putShort: self unknownShortOrCodeSizeInKs toFile: f.
self putLong: desiredEdenBytes toFile: f.
self putShort: (maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]) toFile: f.
self putShort: 0 toFile: f.
1 to: 4 do: [:i | self putLong: 0 toFile: f]. "fill remaining header words with zeros"
self successful ifFalse: [
"file write or seek failure"
self cCode: 'sqImageFileClose(f)'.
^ nil].
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"write the image data"
memStart := objectMemory startOfMemory.
bytesWritten := self cCode: 'sqImageFileWrite(pointerForOop(memStart), sizeof(unsigned char), imageBytes, f)'.
self success: bytesWritten = imageBytes.
self touch: memStart.
self cCode: 'sqImageFileClose(f)'
!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveSetGCSemaphore (in category 'memory space primitives') -----
primitiveSetGCSemaphore
"Primitive. Indicate the semaphore to be signalled for upon garbage collection"
| index |
<export: true>
index := self stackIntegerValue: 0.
self successful ifTrue:[
+ objectMemory setGcSemaphoreIndex: index.
- gcSemaphoreIndex := index.
self pop: argumentCount.
]!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveSignalAtMilliseconds (in category 'system control primitives') -----
primitiveSignalAtMilliseconds
"Cause the time semaphore, if one has been registered, to be
signalled when the microsecond clock is greater than or equal to
the given tick value. A tick value of zero turns off timer interrupts."
| msecsObj msecs deltaMsecs sema |
<var: #msecs type: #usqInt>
msecsObj := self stackTop.
sema := self stackValue: 1.
msecs := self positive32BitValueOf: msecsObj.
(self failed
or: [objectMemory isIntegerObject: sema]) ifTrue:
[self primitiveFail.
^nil].
(objectMemory fetchClassOfNonInt: sema) = (objectMemory splObj: ClassSemaphore)
ifTrue:
[objectMemory splObj: TheTimerSemaphore put: sema.
deltaMsecs := msecs - (self ioMSecs bitAnd: MillisecondClockMask).
deltaMsecs < 0 ifTrue:
[deltaMsecs := deltaMsecs + MillisecondClockMask + 1].
nextWakeupUsecs := self ioUTCMicroseconds + (deltaMsecs * 1000)]
ifFalse:
[objectMemory
storePointer: TheTimerSemaphore
+ ofObject: objectMemory getSpecialObjectsOop
- ofObject: objectMemory specialObjectsOop
withValue: objectMemory nilObject.
nextWakeupUsecs := 0].
self pop: 2!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveSignalAtUTCMicroseconds (in category 'system control primitives') -----
primitiveSignalAtUTCMicroseconds
"Cause the time semaphore, if one has been registered, to be
signalled when the microsecond clock is greater than or equal to
the given tick value. A tick value of zero turns off timer interrupts."
| usecsObj sema usecs |
<var: #usecs type: #usqLong>
usecsObj := self stackTop.
sema := self stackValue: 1.
usecs := self positive64BitValueOf: usecsObj.
(self failed
or: [objectMemory isIntegerObject: sema]) ifTrue:
[self primitiveFail.
^nil].
(objectMemory fetchClassOfNonInt: sema) = (objectMemory splObj: ClassSemaphore)
ifTrue:
[objectMemory splObj: TheTimerSemaphore put: sema.
nextWakeupUsecs := usecs]
ifFalse:
[objectMemory
storePointer: TheTimerSemaphore
+ ofObject: objectMemory getSpecialObjectsOop
- ofObject: objectMemory specialObjectsOop
withValue: objectMemory nilObject.
nextWakeupUsecs := 0].
self pop: 2!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StackInterpreterSimulator>>allObjectsDo: (in category 'debug support') -----
allObjectsDo: objBlock
| oop |
oop := objectMemory firstObject.
+ [oop < objectMemory getEndOfMemory] whileTrue:
- [oop < objectMemory endOfMemory] whileTrue:
[(objectMemory isFreeObject: oop)
ifFalse: [objBlock value: oop].
oop := objectMemory objectAfter: oop].
!
Item was changed:
----- Method: StackInterpreterSimulator>>allObjectsSelect: (in category 'debug support') -----
allObjectsSelect: objBlock
"self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]"
| oop selected |
oop := objectMemory firstObject.
selected := OrderedCollection new.
+ [oop < objectMemory getEndOfMemory] whileTrue:
- [oop < objectMemory endOfMemory] whileTrue:
[(objectMemory isFreeObject: oop)
ifFalse: [(objBlock value: oop) ifTrue: [selected addLast: oop]].
oop := objectMemory objectAfter: oop].
^ selected!
Item was changed:
----- Method: StackInterpreterSimulator>>convertToArray (in category 'initialization') -----
convertToArray
"I dont believe it -- this *just works*"
+ objectMemory setMemory: (objectMemory getMemory as: Array)!
- objectMemory memory: (objectMemory memory as: Array)!
Item was changed:
----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the StackInterpreterSimulator when running the interpreter
inside Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
| objectMemoryClass |
"initialize class variables"
objectMemory ifNotNil:
[^self halt].
objectMemoryClass := self class objectMemoryClass.
objectMemoryClass initBytesPerWord: objectMemoryClass bytesPerWord.
objectMemoryClass initialize.
StackInterpreter initialize.
super initialize.
objectMemory := objectMemoryClass simulatorClass new.
objectMemory coInterpreter: self.
"Note: we must initialize ConstMinusOne differently for simulation,
due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := objectMemory integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
self flushAtCache.
+ objectMemory setGcSemaphoreIndex: 0.
- gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
pluginList := #().
mappedPluginEntries := #().
desiredNumStackPages := desiredEdenBytes := 0.
startMicroseconds := Time totalSeconds * 1000000.
"initialize InterpreterSimulator variables used for debugging"
byteCount := 0.
sendCount := 0.
quitBlock := [^ self].
traceOn := true.
printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
transcript := Transcript.
displayForm := 'Display has not yet been installed' asDisplayText form.
suppressHeartbeatFlag := false.
extSemTabSize := 256.
disableBooleanCheat := false!
Item was changed:
----- Method: StackInterpreterSimulator>>integerAt: (in category 'memory access') -----
integerAt: byteAddress
"Note: Adjusted for Smalltalk's 1-based array indexing."
+ ^objectMemory getMemory integerAt: (byteAddress // 4) + 1!
- ^objectMemory memory integerAt: (byteAddress // 4) + 1!
Item was changed:
----- Method: StackInterpreterSimulator>>integerAt:put: (in category 'memory access') -----
integerAt: byteAddress put: a32BitValue
"Note: Adjusted for Smalltalk's 1-based array indexing."
+ ^objectMemory getMemory integerAt: (byteAddress // 4) + 1 put: a32BitValue!
- ^objectMemory memory integerAt: (byteAddress // 4) + 1 put: a32BitValue!
Item was changed:
----- Method: StackInterpreterSimulator>>objectBefore: (in category 'testing') -----
objectBefore: addr
| oop prev |
oop := objectMemory firstObject.
+ [oop < objectMemory getEndOfMemory] whileTrue:
- [oop < objectMemory endOfMemory] whileTrue:
[prev := oop. "look here if debugging prev obj overlapping this one"
oop := objectMemory objectAfter: oop.
oop >= addr ifTrue: [^ prev]].
^0!
Item was changed:
----- Method: StackInterpreterSimulator>>openOn:extraMemory: (in category 'initialization') -----
openOn: fileName extraMemory: extraBytes
"InterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
| f version headerSize count oldBaseAddr bytesToShift swapBytes
hdrNumStackPages hdrEdenBytes headerFlags |
"open image file and read the header"
["begin ensure block..."
f := FileStream readOnlyFileNamed: fileName.
imageName := f fullName.
f binary.
version := self nextLongFrom: f. "current version: 16r1968 (=6504) vive la revolucion!!"
(self readableFormat: version)
ifTrue: [swapBytes := false]
ifFalse: [(version := objectMemory byteSwapped: version) = self imageFormatVersion
ifTrue: [swapBytes := true]
ifFalse: [self error: 'incomaptible image format']].
headerSize := self nextLongFrom: f swap: swapBytes.
objectMemory setEndOfMemory: (self nextLongFrom: f swap: swapBytes). "first unused location in heap"
oldBaseAddr := self nextLongFrom: f swap: swapBytes. "object memory base address of image"
+ objectMemory setSpecialObjectsOop: (self nextLongFrom: f swap: swapBytes).
+ objectMemory setLastHash: (self nextLongFrom: f swap: swapBytes). "Should be loaded from, and saved to the image header"
- objectMemory specialObjectsOop: (self nextLongFrom: f swap: swapBytes).
- objectMemory lastHash: (self nextLongFrom: f swap: swapBytes). "Should be loaded from, and saved to the image header"
savedWindowSize := self nextLongFrom: f swap: swapBytes.
headerFlags := self nextLongFrom: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self nextLongFrom: f swap: swapBytes.
hdrNumStackPages := self nextShortFrom: f swap: swapBytes.
"4 stack pages is small. Should be able to run with as few as
three. 4 should be comfortable but slow. 8 is a reasonable
default. Can be changed via vmParameterAt: 43 put: n"
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
stackPages := self stackPagesClass new. "Temporary for computeStackZoneSize"
"pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
Preserve it to be polite to images run on Cog."
theUnknownShort := self getShortFromFile: f swap: swapBytes.
hdrEdenBytes := self nextLongFrom: f swap: swapBytes.
+ objectMemory setEdenBytes: (hdrEdenBytes = 0
- objectMemory edenBytes: (hdrEdenBytes = 0
ifTrue: [objectMemory defaultEdenBytes]
ifFalse: [hdrEdenBytes]).
desiredEdenBytes := hdrEdenBytes.
"allocate interpreter memory"
+ objectMemory setMemoryLimit: objectMemory getEndOfMemory + extraBytes + objectMemory edenBytes + self interpreterAllocationReserveBytes.
- objectMemory setMemoryLimit: objectMemory endOfMemory + extraBytes + objectMemory edenBytes + self interpreterAllocationReserveBytes.
"read in the image in bulk, then swap the bytes if necessary"
f position: headerSize.
+ objectMemory setMemory: (Bitmap new: objectMemory getMemoryLimit // 4).
+ count := f readInto: objectMemory getMemory startingAt: 1 count: objectMemory getEndOfMemory // 4.
+ count ~= (objectMemory getEndOfMemory // 4) ifTrue: [self halt].
- objectMemory memory: (Bitmap new: objectMemory memoryLimit // 4).
- count := f readInto: objectMemory memory startingAt: 1 count: objectMemory endOfMemory // 4.
- count ~= (objectMemory endOfMemory // 4) ifTrue: [self halt].
]
ensure: [f close].
self ensureImageFormatIsUpToDate: swapBytes.
objectMemory initialize.
bytesToShift := objectMemory startOfMemory - oldBaseAddr. "adjust pointers for zero base address"
Utilities informUser: 'Relocating object pointers...'
during: [self initializeInterpreter: bytesToShift].
!
Item was changed:
----- Method: StackInterpreterSimulator>>reverseBytesFrom:to: (in category 'initialization') -----
reverseBytesFrom: begin to: end
"Byte-swap the given range of memory (not inclusive!!)."
| wordAddr |
wordAddr := begin.
+ objectMemory getMemory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
- objectMemory memory swapBytesFrom: wordAddr // 4 + 1 to: end // 4!
Item was changed:
----- Method: StackInterpreterSimulator>>showDisplayBits:w:h:d:left:right:top:bottom: (in category 'I/O primitives') -----
showDisplayBits: destBits w: w h: h d: d left: left right: right top: top bottom: bottom
| raster pixPerWord simDisp realDisp rect |
pixPerWord := 32 // d.
raster := displayForm width + (pixPerWord - 1) // pixPerWord.
+ simDisp := Form new hackBits: objectMemory getMemory.
- simDisp := Form new hackBits: objectMemory memory.
displayForm unhibernate.
realDisp := Form new hackBits: displayForm bits.
realDisp
copy: (0 @ (top * raster) extent: 4 @ (bottom - top * raster))
from: 0 @ (destBits // 4 + (top * raster))
in: simDisp
rule: Form over.
displayView ifNotNil: [^ displayView changed].
"If running without a view, just blat the bits onto the screen..."
rect := 0 @ top corner: displayForm width @ bottom.
Display
copy: (rect translateBy: self displayLocation)
from: rect topLeft
in: displayForm
rule: Form over!
Item was changed:
----- Method: StackInterpreterSimulator>>sqGrowMemory:By: (in category 'memory access') -----
sqGrowMemory: oldLimit By: delta
transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr.
+ objectMemory setMemory: objectMemory getMemory , (objectMemory getMemory class new: delta // 4).
+ ^ objectMemory getMemory size * 4!
- objectMemory memory: objectMemory memory , (objectMemory memory class new: delta // 4).
- ^ objectMemory memory size * 4!
Item was changed:
----- Method: StackInterpreterSimulator>>validOop: (in category 'testing') -----
validOop: oop
" Return true if oop appears to be valid "
(oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer"
(oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address"
+ oop >= objectMemory getEndOfMemory ifTrue: [^ false]. "Out of range"
- oop >= objectMemory endOfMemory ifTrue: [^ false]. "Out of range"
"could test if within the first large freeblock"
(self longAt: oop) = 4 ifTrue: [^ false].
(objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object"
^ true!
Item was changed:
----- Method: StackInterpreterSimulator>>writeEnableMemory (in category 'debug printing') -----
writeEnableMemory
+ objectMemory setMemory: objectMemory getMemory array!
- objectMemory memory: objectMemory memory array!
Item was changed:
----- Method: StackInterpreterSimulator>>writeImageFileIO: (in category 'image save/restore') -----
writeImageFileIO: numberOfBytesToWrite
"Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
| headerSize file |
BytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
headerSize := 64.
[
file := (FileStream fileNamed: imageName) binary.
file == nil ifTrue: [^nil].
{
self imageFormatVersion.
headerSize.
numberOfBytesToWrite.
objectMemory startOfMemory.
+ (objectMemory getSpecialObjectsOop).
+ (objectMemory getLastHash).
- (objectMemory specialObjectsOop).
- (objectMemory lastHash).
self ioScreenSize.
fullScreenFlag.
extraVMMemory
}
do: [:long | self putLong: long toFile: file].
{ desiredNumStackPages. self unknownShortOrCodeSizeInKs } do:
[:short| self putShort: short toFile: file].
self putLong: desiredEdenBytes toFile: file.
{ maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]. 0 } do:
[:short| self putShort: short toFile: file].
"Pad the rest of the header."
4 timesRepeat: [self putLong: 0 toFile: file].
"Position the file after the header."
file position: headerSize.
"Write the object memory."
objectMemory startOfMemory // 4 + 1
to: numberOfBytesToWrite // 4
do: [:index |
self
+ putLong: (objectMemory getMemory at: index)
- putLong: (objectMemory memory at: index)
toFile: file].
self success: true
]
ensure: [file close]!
Item was changed:
----- Method: StackInterpreterSimulator>>writeProtectMemory (in category 'debug printing') -----
writeProtectMemory
+ objectMemory setMemory: (ReadOnlyArrayWrapper around: objectMemory getMemory)!
- objectMemory memory: (ReadOnlyArrayWrapper around: objectMemory memory)!
Item was changed:
----- Method: VMMaker class>>versionString (in category 'version testing') -----
versionString
"VMMaker versionString"
+ ^'4.13.3'!
- ^'4.13.2'!
1
0
20 Feb '14
Revision: 2869
Author: eliot
Date: 2014-02-19 18:06:56 -0800 (Wed, 19 Feb 2014)
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.620
Make primitiveClone cope with variable args, cloning its last
argument. This for the Newspeak VMMirror.
Fix an assert fail in findSPOrNilOf:on:startingFrom:.
Spur:
Fix scanClassPostBecome:effects: for the bogus temp classes the
Newspeak bootstrap creates.
Get obj stack swizzling correct.
Update firstFreeChunk correctly when it is allocated in the compaction routines.
Break out of the search loop sooner in allocateOldSpaceChunkOfBytes:suchThat:.
Make Spur snapshot avoid writing trailing free space in each
segment to the image file.
Modified Paths:
--------------
branches/Cog/nscogsrc/plugins/FilePlugin/FilePlugin.c
branches/Cog/nscogsrc/vm/cointerp.c
branches/Cog/nscogsrc/vm/cointerp.h
branches/Cog/nscogsrc/vm/gcc3x-cointerp.c
branches/Cog/nscogsrc/vm/interp.h
branches/Cog/nscogsrc/vm/vmCallback.h
branches/Cog/nsspurstacksrc/vm/gcc3x-interp.c
branches/Cog/nsspurstacksrc/vm/interp.c
branches/Cog/nsspurstacksrc/vm/interp.h
branches/Cog/nsspurstacksrc/vm/vmCallback.h
branches/Cog/spursrc/vm/cogit.c
branches/Cog/spursrc/vm/cogit.h
branches/Cog/spursrc/vm/cogmethod.h
branches/Cog/spursrc/vm/cointerp.c
branches/Cog/spursrc/vm/cointerp.h
branches/Cog/spursrc/vm/gcc3x-cointerp.c
branches/Cog/spursrc/vm/interp.h
branches/Cog/spursrc/vm/vmCallback.h
branches/Cog/spurstacksrc/vm/gcc3x-interp.c
branches/Cog/spurstacksrc/vm/interp.c
branches/Cog/spurstacksrc/vm/interp.h
branches/Cog/spurstacksrc/vm/vmCallback.h
branches/Cog/src/plugins/FilePlugin/FilePlugin.c
branches/Cog/src/vm/cointerp.c
branches/Cog/src/vm/cointerp.h
branches/Cog/src/vm/cointerpmt.c
branches/Cog/src/vm/cointerpmt.h
branches/Cog/src/vm/gcc3x-cointerp.c
branches/Cog/src/vm/gcc3x-cointerpmt.c
branches/Cog/src/vm/interp.h
branches/Cog/src/vm/vmCallback.h
branches/Cog/stacksrc/vm/gcc3x-interp.c
branches/Cog/stacksrc/vm/interp.c
branches/Cog/stacksrc/vm/interp.h
branches/Cog/stacksrc/vm/vmCallback.h
Property Changed:
----------------
branches/Cog/platforms/Cross/vm/sqSCCSVersion.h
Modified: branches/Cog/nscogsrc/plugins/FilePlugin/FilePlugin.c
===================================================================
--- branches/Cog/nscogsrc/plugins/FilePlugin/FilePlugin.c 2014-02-18 00:00:50 UTC (rev 2868)
+++ branches/Cog/nscogsrc/plugins/FilePlugin/FilePlugin.c 2014-02-20 02:06:56 UTC (rev 2869)
@@ -1,9 +1,9 @@
/* Automatically generated by
- VMPluginCodeGenerator VMMaker.oscog-eem.580 uuid: 751b08d4-d92e-440a-b3f6-cb2c76f52514
+ VMPluginCodeGenerator VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
from
- FilePlugin VMMaker.oscog-eem.580 uuid: 751b08d4-d92e-440a-b3f6-cb2c76f52514
+ FilePlugin VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
*/
-static char __buildInfo[] = "FilePlugin VMMaker.oscog-eem.580 uuid: 751b08d4-d92e-440a-b3f6-cb2c76f52514 " __DATE__ ;
+static char __buildInfo[] = "FilePlugin VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9 " __DATE__ ;
@@ -180,9 +180,9 @@
struct VirtualMachine* interpreterProxy;
static const char *moduleName =
#ifdef SQUEAK_BUILTIN_PLUGIN
- "FilePlugin VMMaker.oscog-eem.580 (i)"
+ "FilePlugin VMMaker.oscog-eem.620 (i)"
#else
- "FilePlugin VMMaker.oscog-eem.580 (e)"
+ "FilePlugin VMMaker.oscog-eem.620 (e)"
#endif
;
static void * sCCPfn;
@@ -659,16 +659,12 @@
typeString = stackValue(1);
fileName = stackValue(2);
if (!((isBytes(creatorString))
- && ((byteSizeOf(creatorString)) == 4))) {
+ && ((isBytes(typeString))
+ && ((isBytes(fileName))
+ && (((byteSizeOf(creatorString)) == 4)
+ && ((byteSizeOf(typeString)) == 4)))))) {
return primitiveFail();
}
- if (!((isBytes(typeString))
- && ((byteSizeOf(typeString)) == 4))) {
- return primitiveFail();
- }
- if (!(isBytes(fileName))) {
- return primitiveFail();
- }
creatorStringIndex = firstIndexableField(creatorString);
typeStringIndex = firstIndexableField(typeString);
fileNameIndex = firstIndexableField(fileName);
@@ -678,12 +674,12 @@
fileNameSize = byteSizeOf(fileName);
if (sCSFTfn != 0) {
- okToSet = ((sqInt (*)(char *, sqInt))sCSFTfn)(fileNameIndex, fileNameSize);
+ okToSet = ((sqInt (*)(char *, sqInt))sCSFTfn)(fileNameIndex, fileNameSize);
if (!okToSet) {
return primitiveFail();
}
}
- if (!(dir_SetMacFileTypeAndCreator(fileNameIndex, fileNameSize,typeStringIndex, creatorStringIndex))) {
+ if (!(dir_SetMacFileTypeAndCreator(fileNameIndex, fileNameSize, typeStringIndex, creatorStringIndex))) {
return primitiveFail();
}
pop(3);
Modified: branches/Cog/nscogsrc/vm/cointerp.c
===================================================================
--- branches/Cog/nscogsrc/vm/cointerp.c 2014-02-18 00:00:50 UTC (rev 2868)
+++ branches/Cog/nscogsrc/vm/cointerp.c 2014-02-20 02:06:56 UTC (rev 2869)
@@ -1,9 +1,9 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
from
- CoInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ CoInterpreter VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
*/
-static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3 " __DATE__ ;
+static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9 " __DATE__ ;
char *__interpBuildInfo = __buildInfo;
@@ -2032,7 +2032,7 @@
/* 574 */ (void (*)(void))0,
/* 575 */ (void (*)(void))0,
0 };
-const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreter_VMMaker.oscog-eem.612";
+const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreter_VMMaker.oscog-eem.620";
sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 10 */;
volatile int sendTrace;
@@ -4826,6 +4826,7 @@
GIV(framePointer) = localFP;
ceEnterCogCodePopReceiverReg();
+ null;
goto l307;
}
localIP = pointerForOop(longAt(localFP + FoxIFSavedIP));
@@ -4843,7 +4844,7 @@
/* begin fetchNextBytecode */
currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector);
- /* return self */
+ null;
l307: /* end baseFrameReturn */;
goto l304;
}
@@ -21609,17 +21610,15 @@
findSPOfon(char *theFP, StackPage *thePage)
{ DECL_MAYBE_SQ_GLOBAL_STRUCT
char *aFrame;
+ char *prevFrame;
char *startFrame;
char *theSP;
- char *theSP1;
/* begin findSPOrNilOf:on:startingFrom: */
startFrame = (thePage->headFP);
assert(!(isFree(thePage)));
- aFrame = startFrame;
- theSP1 = (thePage->headSP);
- if (aFrame == theFP) {
- if (theSP1 >= aFrame) {
+ if (startFrame == theFP) {
+ if (((thePage->headSP)) >= startFrame) {
/* If the SP is invalid return the pointer to the receiver field. */
@@ -21630,21 +21629,22 @@
goto l1;
}
theSP = (thePage == GIV(stackPage)
- ? theSP1
- : theSP1 + BytesPerWord);
+ ? (thePage->headSP)
+ : ((thePage->headSP)) + BytesPerWord);
goto l1;
}
+ aFrame = startFrame;
while (1) {
- /* begin frameCallerSP: */
- assert(!(isBaseFrame(aFrame)));
- theSP1 = (aFrame + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(aFrame + FoxMethod)))) < (startOfMemory())
- ? ((mframeCogMethod(aFrame))->cmNumArgs)
- : byteAt((aFrame + FoxIFrameFlags) + 1))))) + BytesPerWord;
+ prevFrame = aFrame;
/* begin frameCallerFP: */
aFrame = pointerForOop(longAt(aFrame + FoxSavedFP));
if (!(aFrame != 0)) break;
if (theFP == aFrame) {
- theSP = theSP1;
+ /* begin frameCallerSP: */
+ assert(!(isBaseFrame(prevFrame)));
+ theSP = (prevFrame + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(prevFrame + FoxMethod)))) < (startOfMemory())
+ ? ((mframeCogMethod(prevFrame))->cmNumArgs)
+ : byteAt((prevFrame + FoxIFrameFlags) + 1))))) + BytesPerWord;
goto l1;
}
}
@@ -32124,7 +32124,7 @@
}
}
/* begin pop:thenPush: */
- longAtput((sp = GIV(stackPointer) + ((1 - 1) * BytesPerWord)), newCopy);
+ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), newCopy);
GIV(stackPointer) = sp;
}
@@ -46777,10 +46777,10 @@
{ DECL_MAYBE_SQ_GLOBAL_STRUCT
char *aFrame;
sqInt index;
+ char *prevFrame;
char *startFrame;
StackPage *thePage;
char *theSP;
- char *theSP1;
if (theFP == GIV(framePointer)) {
theSP = GIV(stackPointer);
@@ -46811,10 +46811,8 @@
? GIV(framePointer)
: (thePage->headFP));
assert(!(isFree(thePage)));
- aFrame = startFrame;
- theSP1 = (thePage->headSP);
- if (aFrame == theFP) {
- if (theSP1 >= aFrame) {
+ if (startFrame == theFP) {
+ if (((thePage->headSP)) >= startFrame) {
/* If the SP is invalid return the pointer to the receiver field. */
@@ -46825,21 +46823,22 @@
goto l1;
}
theSP = (thePage == GIV(stackPage)
- ? theSP1
- : theSP1 + BytesPerWord);
+ ? (thePage->headSP)
+ : ((thePage->headSP)) + BytesPerWord);
goto l1;
}
+ aFrame = startFrame;
while (1) {
- /* begin frameCallerSP: */
- assert(!(isBaseFrame(aFrame)));
- theSP1 = (aFrame + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(aFrame + FoxMethod)))) < (startOfMemory())
- ? ((mframeCogMethod(aFrame))->cmNumArgs)
- : byteAt((aFrame + FoxIFrameFlags) + 1))))) + BytesPerWord;
+ prevFrame = aFrame;
/* begin frameCallerFP: */
aFrame = pointerForOop(longAt(aFrame + FoxSavedFP));
if (!(aFrame != 0)) break;
if (theFP == aFrame) {
- theSP = theSP1;
+ /* begin frameCallerSP: */
+ assert(!(isBaseFrame(prevFrame)));
+ theSP = (prevFrame + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(prevFrame + FoxMethod)))) < (startOfMemory())
+ ? ((mframeCogMethod(prevFrame))->cmNumArgs)
+ : byteAt((prevFrame + FoxIFrameFlags) + 1))))) + BytesPerWord;
goto l1;
}
}
@@ -51939,6 +51938,7 @@
}
longAtput((activeContext + BaseHeaderSize) + (StackPointerIndex << ShiftForWord), (((stackIndex - 1) << 1) | 1));
}
+ /* begin postSnapshot */
marryContextInNewStackPageAndInitializeInterpreterRegisters(activeContext);
if (!GIV(primFailCode)) {
/* begin push: */
Modified: branches/Cog/nscogsrc/vm/cointerp.h
===================================================================
--- branches/Cog/nscogsrc/vm/cointerp.h 2014-02-18 00:00:50 UTC (rev 2868)
+++ branches/Cog/nscogsrc/vm/cointerp.h 2014-02-20 02:06:56 UTC (rev 2869)
@@ -1,5 +1,5 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
*/
Modified: branches/Cog/nscogsrc/vm/gcc3x-cointerp.c
===================================================================
--- branches/Cog/nscogsrc/vm/gcc3x-cointerp.c 2014-02-18 00:00:50 UTC (rev 2868)
+++ branches/Cog/nscogsrc/vm/gcc3x-cointerp.c 2014-02-20 02:06:56 UTC (rev 2869)
@@ -2,11 +2,11 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
from
- CoInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ CoInterpreter VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
*/
-static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3 " __DATE__ ;
+static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9 " __DATE__ ;
char *__interpBuildInfo = __buildInfo;
@@ -2035,7 +2035,7 @@
/* 574 */ (void (*)(void))0,
/* 575 */ (void (*)(void))0,
0 };
-const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreter_VMMaker.oscog-eem.612";
+const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreter_VMMaker.oscog-eem.620";
sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 10 */;
volatile int sendTrace;
@@ -4835,6 +4835,7 @@
GIV(framePointer) = localFP;
ceEnterCogCodePopReceiverReg();
+ null;
goto l307;
}
localIP = pointerForOop(longAt(localFP + FoxIFSavedIP));
@@ -4852,7 +4853,7 @@
/* begin fetchNextBytecode */
currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector);
- /* return self */
+ null;
l307: /* end baseFrameReturn */;
goto l304;
}
@@ -21618,17 +21619,15 @@
findSPOfon(char *theFP, StackPage *thePage)
{ DECL_MAYBE_SQ_GLOBAL_STRUCT
char *aFrame;
+ char *prevFrame;
char *startFrame;
char *theSP;
- char *theSP1;
/* begin findSPOrNilOf:on:startingFrom: */
startFrame = (thePage->headFP);
assert(!(isFree(thePage)));
- aFrame = startFrame;
- theSP1 = (thePage->headSP);
- if (aFrame == theFP) {
- if (theSP1 >= aFrame) {
+ if (startFrame == theFP) {
+ if (((thePage->headSP)) >= startFrame) {
/* If the SP is invalid return the pointer to the receiver field. */
@@ -21639,21 +21638,22 @@
goto l1;
}
theSP = (thePage == GIV(stackPage)
- ? theSP1
- : theSP1 + BytesPerWord);
+ ? (thePage->headSP)
+ : ((thePage->headSP)) + BytesPerWord);
goto l1;
}
+ aFrame = startFrame;
while (1) {
- /* begin frameCallerSP: */
- assert(!(isBaseFrame(aFrame)));
- theSP1 = (aFrame + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(aFrame + FoxMethod)))) < (startOfMemory())
- ? ((mframeCogMethod(aFrame))->cmNumArgs)
- : byteAt((aFrame + FoxIFrameFlags) + 1))))) + BytesPerWord;
+ prevFrame = aFrame;
/* begin frameCallerFP: */
aFrame = pointerForOop(longAt(aFrame + FoxSavedFP));
if (!(aFrame != 0)) break;
if (theFP == aFrame) {
- theSP = theSP1;
+ /* begin frameCallerSP: */
+ assert(!(isBaseFrame(prevFrame)));
+ theSP = (prevFrame + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(prevFrame + FoxMethod)))) < (startOfMemory())
+ ? ((mframeCogMethod(prevFrame))->cmNumArgs)
+ : byteAt((prevFrame + FoxIFrameFlags) + 1))))) + BytesPerWord;
goto l1;
}
}
@@ -32133,7 +32133,7 @@
}
}
/* begin pop:thenPush: */
- longAtput((sp = GIV(stackPointer) + ((1 - 1) * BytesPerWord)), newCopy);
+ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), newCopy);
GIV(stackPointer) = sp;
}
@@ -46786,10 +46786,10 @@
{ DECL_MAYBE_SQ_GLOBAL_STRUCT
char *aFrame;
sqInt index;
+ char *prevFrame;
char *startFrame;
StackPage *thePage;
char *theSP;
- char *theSP1;
if (theFP == GIV(framePointer)) {
theSP = GIV(stackPointer);
@@ -46820,10 +46820,8 @@
? GIV(framePointer)
: (thePage->headFP));
assert(!(isFree(thePage)));
- aFrame = startFrame;
- theSP1 = (thePage->headSP);
- if (aFrame == theFP) {
- if (theSP1 >= aFrame) {
+ if (startFrame == theFP) {
+ if (((thePage->headSP)) >= startFrame) {
/* If the SP is invalid return the pointer to the receiver field. */
@@ -46834,21 +46832,22 @@
goto l1;
}
theSP = (thePage == GIV(stackPage)
- ? theSP1
- : theSP1 + BytesPerWord);
+ ? (thePage->headSP)
+ : ((thePage->headSP)) + BytesPerWord);
goto l1;
}
+ aFrame = startFrame;
while (1) {
- /* begin frameCallerSP: */
- assert(!(isBaseFrame(aFrame)));
- theSP1 = (aFrame + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(aFrame + FoxMethod)))) < (startOfMemory())
- ? ((mframeCogMethod(aFrame))->cmNumArgs)
- : byteAt((aFrame + FoxIFrameFlags) + 1))))) + BytesPerWord;
+ prevFrame = aFrame;
/* begin frameCallerFP: */
aFrame = pointerForOop(longAt(aFrame + FoxSavedFP));
if (!(aFrame != 0)) break;
if (theFP == aFrame) {
- theSP = theSP1;
+ /* begin frameCallerSP: */
+ assert(!(isBaseFrame(prevFrame)));
+ theSP = (prevFrame + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(prevFrame + FoxMethod)))) < (startOfMemory())
+ ? ((mframeCogMethod(prevFrame))->cmNumArgs)
+ : byteAt((prevFrame + FoxIFrameFlags) + 1))))) + BytesPerWord;
goto l1;
}
}
@@ -51948,6 +51947,7 @@
}
longAtput((activeContext + BaseHeaderSize) + (StackPointerIndex << ShiftForWord), (((stackIndex - 1) << 1) | 1));
}
+ /* begin postSnapshot */
marryContextInNewStackPageAndInitializeInterpreterRegisters(activeContext);
if (!GIV(primFailCode)) {
/* begin push: */
Modified: branches/Cog/nscogsrc/vm/interp.h
===================================================================
--- branches/Cog/nscogsrc/vm/interp.h 2014-02-18 00:00:50 UTC (rev 2868)
+++ branches/Cog/nscogsrc/vm/interp.h 2014-02-20 02:06:56 UTC (rev 2869)
@@ -1,5 +1,5 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
*/
#define VM_PROXY_MAJOR 1
Modified: branches/Cog/nscogsrc/vm/vmCallback.h
===================================================================
--- branches/Cog/nscogsrc/vm/vmCallback.h 2014-02-18 00:00:50 UTC (rev 2868)
+++ branches/Cog/nscogsrc/vm/vmCallback.h 2014-02-20 02:06:56 UTC (rev 2869)
@@ -1,5 +1,5 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
*/
#define VM_CALLBACK_INC 1
Modified: branches/Cog/nsspurstacksrc/vm/gcc3x-interp.c
===================================================================
--- branches/Cog/nsspurstacksrc/vm/gcc3x-interp.c 2014-02-18 00:00:50 UTC (rev 2868)
+++ branches/Cog/nsspurstacksrc/vm/gcc3x-interp.c 2014-02-20 02:06:56 UTC (rev 2869)
@@ -2,11 +2,11 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
from
- StackInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ StackInterpreter VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
*/
-static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3 " __DATE__ ;
+static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9 " __DATE__ ;
char *__interpBuildInfo = __buildInfo;
@@ -74,6 +74,8 @@
usqInt segSize;
sqInt swizzle;
usqInt containsPinned;
+ usqInt savedSegSize;
+ usqInt lastFreeObject;
} SpurSegmentInfo;
@@ -483,7 +485,7 @@
static sqInt fetchPointerofFreeChunk(sqInt fieldIndex, sqInt objOop);
sqInt fetchPointerofObject(sqInt fieldIndex, sqInt objOop);
static sqInt fetchStackPointerOf(sqInt aContext);
-static void fillHighestObjectsWithMovableObjectsFromupTo(sqInt startObj, sqInt limitObj);
+static void fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo(sqInt limitObj);
static sqInt findApplicationOfTargetMixinstartingAtBehavior(sqInt targetMixin, sqInt aBehavior);
static sqInt findClassContainingMethodstartingAt(sqInt meth, sqInt classObj);
sqInt findClassOfMethodforReceiver(sqInt meth, sqInt rcvr);
@@ -608,6 +610,7 @@
static sqInt isContextHeader(sqInt aHeader);
static sqInt isContextNonImm(sqInt oop);
static sqInt isContext(sqInt oop);
+static sqInt isEmptyObjStack(sqInt objStack);
static sqInt isEnumerableObjectNoAssert(sqInt objOop);
static sqInt isEnumerableObject(sqInt objOop);
static sqInt isEphemeron(sqInt objOop);
@@ -651,6 +654,7 @@
static sqInt isScavengeSurvivor(sqInt oop);
static sqInt isSegmentBridge(sqInt objOop);
static sqInt isSingleContext(sqInt aContext);
+static sqInt isValidClassIndex(sqInt classIndex);
static sqInt isValidFreeObject(sqInt objOop);
static sqInt isValidObjStackAt(sqInt objStackRootIndex);
static sqInt isValidObjStackPagemyIndex(sqInt objStackPage, sqInt myx);
@@ -1213,8 +1217,8 @@
_iss sqInt primFailCode;
_iss sqInt specialObjectsOop;
_iss usqInt method;
+_iss sqInt nilObj;
_iss StackPage * stackPage;
-_iss sqInt nilObj;
_iss sqInt bytecodeSetSelector;
_iss char * framePointer;
_iss sqInt argumentCount;
@@ -1230,24 +1234,24 @@
_iss sqInt trueObj;
_iss sqInt falseObj;
_iss sqInt remapBufferCount;
+_iss SpurSegmentInfo * segments;
_iss sqInt * freeLists;
_iss StackPage * pages;
-_iss SpurSegmentInfo * segments;
_iss usqInt freeListsMask;
_iss usqInt pastSpaceStart;
+_iss sqInt numSegments;
_iss char * stackMemory;
+_iss sqInt firstFreeChunk;
_iss char * stackLimit;
+_iss sqInt weaklingStack;
_iss sqInt bytesPerPage;
_iss sqInt rememberedSetSize;
_iss SpurNewSpaceSpace pastSpace;
-_iss sqInt weaklingStack;
_iss SpurContiguousObjStack unscannedEphemerons;
_iss SpurNewSpaceSpace futureSpace;
-_iss sqInt numSegments;
_iss StackPage * mostRecentlyUsedPage;
_iss sqInt classTableFirstPage;
_iss usqInt newSpaceStart;
-_iss sqInt firstFreeChunk;
_iss sqInt futureSurvivorStart;
_iss usqInt oldSpaceStart;
_iss sqInt jmpDepth;
@@ -1267,8 +1271,10 @@
_iss sqInt profileProcess;
_iss sqInt extraRootCount;
_iss sqInt invalidObjStackPage;
+_iss sqInt lastSubdividedFreeChunk;
_iss sqInt previousRememberedSetSize;
_iss unsigned char * classTableBitmap;
+_iss usqInt freeOldSpaceStart;
_iss sqInt longRunningPrimitiveCheckMethod;
_iss sqInt longRunningPrimitiveCheckSemaphore;
_iss sqInt profileMethod;
@@ -1281,12 +1287,10 @@
_iss sqInt profileSemaphore;
_iss sqInt classTableIndex;
_iss sqInt highestRunnableProcessPriority;
-_iss sqInt lastSubdividedFreeChunk;
_iss usqLong longRunningPrimitiveStartUsecs;
_iss usqLong longRunningPrimitiveStopUsecs;
_iss sqInt numSegInfos;
_iss sqInt statCheckForEvents;
-_iss usqInt freeOldSpaceStart;
_iss usqInt lowSpaceThreshold;
_iss usqLong statGCEndUsecs;
_iss sqInt externalPrimitiveTableFirstFreeIndex;
@@ -1297,13 +1301,13 @@
_iss sqInt weakList;
_iss sqInt firstSegmentSize;
_iss usqLong gcStartUsecs;
+_iss sqInt lastHash;
_iss usqInt memory;
_iss usqInt scavengeThreshold;
_iss sqInt statCompactPassCount;
_iss sqInt thisClassIndex;
_iss sqInt fullScreenFlag;
_iss sqInt interruptPending;
-_iss sqInt lastHash;
_iss sqInt longRunningPrimitiveCheckSequenceNumber;
_iss sqInt marking;
_iss sqInt methodDictLinearSearchLimit;
@@ -1970,7 +1974,7 @@
0 };
char * breakSelector;
sqInt breakSelectorLength = -1;
-const char *interpreterVersion = "Newspeak Virtual Machine StackInterpreter_VMMaker.oscog-eem.612";
+const char *interpreterVersion = "Newspeak Virtual Machine StackInterpreter_VMMaker.oscog-eem.620";
volatile int sendTrace;
sqInt suppressHeartbeatFlag;
@@ -18666,7 +18670,12 @@
static void
compact(void)
{ DECL_MAYBE_SQ_GLOBAL_STRUCT
+ assert((GIV(firstFreeChunk) == 0)
+ || (isFreeObject(GIV(firstFreeChunk))));
exactFitCompact();
+ assert((GIV(firstFreeChunk) == 0)
+ || ((isFreeObject(GIV(firstFreeChunk)))
+ || (isValidClassIndex(classIndexOf(GIV(firstFreeChunk))))));
if ((usedSize(&GIV(highestObjects))) > 0) {
firstFitCompact();
}
@@ -20705,6 +20714,7 @@
sqInt fieldIndex1;
sqInt fieldIndex2;
sqInt first;
+ sqInt fo;
sqInt freeObj;
sqInt freeObj1;
sqInt freeObj2;
@@ -20881,7 +20891,22 @@
longAtput(misfits, longAt(ptr));
}
else {
+
+ /* here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk
+ is a large chunk then firstFreeChunk will no longer point to an object header. So check and
+ adjust firstFreeChunk if it is assigned to. */
+
nfits += 1;
+ /* begin objectStartingAt: */
+ /* begin rawNumSlotsOf: */
+ flag("endianness");
+ numSlots = ((usqInt) (((usqInt)(longAt(f + 4))))) >> 24;
+ fo = (numSlots == 0xFF
+ ? f + (BaseHeaderSize)
+ : f);
+ if (fo == GIV(firstFreeChunk)) {
+ GIV(firstFreeChunk) = objectAfter(fo);
+ }
/* begin copyAndForward:withBytes:toFreeChunk: */
startOfObj = ((rawNumSlotsOf(longAt(ptr))) == 0xFF
? (longAt(ptr)) - (BaseHeaderSize)
@@ -20921,15 +20946,6 @@
}
}
longAtput(((longAt(ptr)) + (BaseHeaderSize)) + (0 << 2), freeObj);
- if (f == GIV(firstFreeChunk)) {
- /* begin objectStartingAt: */
- /* begin rawNumSlotsOf: */
- flag("endianness");
- numSlots = ((usqInt) (((usqInt)(longAt(f + 4))))) >> 24;
- GIV(firstFreeChunk) = (numSlots == 0xFF
- ? f + (BaseHeaderSize)
- : f);
- }
}
}
@@ -21068,7 +21084,22 @@
longAtput(misfits, longAt(ptr));
}
else {
+
+ /* here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk
+ is a large chunk then firstFreeChunk will no longer point to an object header. So check and
+ adjust firstFreeChunk if it is assigned to. */
+
nfits += 1;
+ /* begin objectStartingAt: */
+ /* begin rawNumSlotsOf: */
+ flag("endianness");
+ numSlots = ((usqInt) (((usqInt)(longAt(f + 4))))) >> 24;
+ fo = (numSlots == 0xFF
+ ? f + (BaseHeaderSize)
+ : f);
+ if (fo == GIV(firstFreeChunk)) {
+ GIV(firstFreeChunk) = objectAfter(fo);
+ }
/* begin copyAndForward:withBytes:toFreeChunk: */
startOfObj1 = ((rawNumSlotsOf(longAt(ptr))) == 0xFF
? (longAt(ptr)) - (BaseHeaderSize)
@@ -21108,15 +21139,6 @@
}
}
longAtput(((longAt(ptr)) + (BaseHeaderSize)) + (0 << 2), freeObj1);
- if (f == GIV(firstFreeChunk)) {
- /* begin objectStartingAt: */
- /* begin rawNumSlotsOf: */
- flag("endianness");
- numSlots = ((usqInt) (((usqInt)(longAt(f + 4))))) >> 24;
- GIV(firstFreeChunk) = (numSlots == 0xFF
- ? f + (BaseHeaderSize)
- : f);
- }
}
}
@@ -21247,7 +21269,22 @@
longAtput(misfits, longAt(ptr));
}
else {
+
+ /* here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk
+ is a large chunk then firstFreeChunk will no longer point to an object header. So check and
+ adjust firstFreeChunk if it is assigned to. */
+
nfits += 1;
+ /* begin objectStartingAt: */
+ /* begin rawNumSlotsOf: */
+ flag("endianness");
+ numSlots = ((usqInt) (((usqInt)(longAt(f + 4))))) >> 24;
+ fo = (numSlots == 0xFF
+ ? f + (BaseHeaderSize)
+ : f);
+ if (fo == GIV(firstFreeChunk)) {
+ GIV(firstFreeChunk) = objectAfter(fo);
+ }
/* begin copyAndForward:withBytes:toFreeChunk: */
startOfObj2 = ((rawNumSlotsOf(longAt(ptr))) == 0xFF
? (longAt(ptr)) - (BaseHeaderSize)
@@ -21287,15 +21324,6 @@
}
}
longAtput(((longAt(ptr)) + (BaseHeaderSize)) + (0 << 2), freeObj2);
- if (f == GIV(firstFreeChunk)) {
- /* begin objectStartingAt: */
- /* begin rawNumSlotsOf: */
- flag("endianness");
- numSlots = ((usqInt) (((usqInt)(longAt(f + 4))))) >> 24;
- GIV(firstFreeChunk) = (numSlots == 0xFF
- ? f + (BaseHeaderSize)
- : f);
- }
}
}
@@ -21341,7 +21369,7 @@
memmove(((void *)(oldLimit - bytesToMove)), ((void *)((GIV(highestObjects).start))), bytesToMove);
savedLimit = oldLimit;
l2: /* end moveMisfitsToTopOfHighestObjects: */;
- fillHighestObjectsWithMovableObjectsFromupTo(GIV(firstFreeChunk), first);
+ fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo(first);
/* begin moveMisfitsInHighestObjectsBack: */
if (savedLimit == ((GIV(highestObjects).limit))) {
misfits = (GIV(highestObjects).last);
@@ -22130,12 +22158,10 @@
/* Refill highestObjects with movable objects up to, but not including
- limitObj. c.f. the loop in
- freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace.
- */
+ limitObj. c.f. the loop in freeUnmarkedObjectsAndSortAndCoalesceFreeSpace. */
static void
-fillHighestObjectsWithMovableObjectsFromupTo(sqInt startObj, sqInt limitObj)
+fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo(sqInt limitObj)
{ DECL_MAYBE_SQ_GLOBAL_STRUCT
sqInt firstFree;
sqInt highestObjectsWraps;
@@ -22145,6 +22171,9 @@
sqInt prevObj;
sqInt prevPrevObj;
+ assert((GIV(firstFreeChunk) == 0)
+ || ((isFreeObject(GIV(firstFreeChunk)))
+ || (isValidClassIndex(classIndexOf(GIV(firstFreeChunk))))));
/* begin resetAsEmpty */
(GIV(highestObjects).first) = (GIV(highestObjects).start);
(GIV(highestObjects).last) = ((GIV(highestObjects).start)) - (wordSize());
@@ -22153,16 +22182,17 @@
highestObjectsWraps = (firstFree = 0);
/* begin allOldSpaceEntitiesFrom:do: */
prevPrevObj = (prevObj = null);
- objOop = startObj;
+ objOop = GIV(firstFreeChunk);
while (1) {
assert((objOop % (allocationUnit())) == 0);
if (!((((usqInt) objOop)) < (((usqInt) GIV(endOfMemory))))) break;
assert((longLongAt(objOop)) != 0);
if ((((usqInt) objOop)) >= (((usqInt) limitObj))) {
(GIV(highestObjects).last = lastHighest);
- if ((firstFree != 0)
- && (!(((longAt(GIV(firstFreeChunk))) & 0x3FFFFF) == 0))) {
- GIV(firstFreeChunk) = firstFree;
+ if (!(((longAt(GIV(firstFreeChunk))) & 0x3FFFFF) == 0)) {
+ GIV(firstFreeChunk) = (firstFree == 0
+ ? limitObj
+ : firstFree);
}
return;
}
@@ -22196,10 +22226,14 @@
(GIV(highestObjects).last = lastHighest);
- if ((firstFree != 0)
- && (!(((longAt(GIV(firstFreeChunk))) & 0x3FFFFF) == 0))) {
- GIV(firstFreeChunk) = firstFree;
+ if (!(((longAt(GIV(firstFreeChunk))) & 0x3FFFFF) == 0)) {
+ GIV(firstFreeChunk) = (firstFree == 0
+ ? limitObj
+ : firstFree);
}
+ assert((GIV(firstFreeChunk) == 0)
+ || ((isFreeObject(GIV(firstFreeChunk)))
+ || (isValidClassIndex(classIndexOf(GIV(firstFreeChunk))))));
}
@@ -22683,17 +22717,15 @@
findSPOfon(char *theFP, StackPage *thePage)
{ DECL_MAYBE_SQ_GLOBAL_STRUCT
char *aFrame;
+ char *prevFrame;
char *startFrame;
char *theSP;
- char *theSP1;
/* begin findSPOrNilOf:on:startingFrom: */
startFrame = (thePage->headFP);
assert(!(isFree(thePage)));
- aFrame = startFrame;
- theSP1 = (thePage->headSP);
- if (aFrame == theFP) {
- if (theSP1 >= aFrame) {
+ if (startFrame == theFP) {
+ if (((thePage->headSP)) >= startFrame) {
/* If the SP is invalid return the pointer to the receiver field. */
@@ -22702,19 +22734,20 @@
goto l1;
}
theSP = (thePage == GIV(stackPage)
- ? theSP1
- : theSP1 + BytesPerWord);
+ ? (thePage->headSP)
+ : ((thePage->headSP)) + BytesPerWord);
goto l1;
}
+ aFrame = startFrame;
while (1) {
- /* begin frameCallerSP: */
- assert(!(isBaseFrame(aFrame)));
- theSP1 = (aFrame + ((FoxCallerSavedIP + BytesPerWord) + ((byteAt((aFrame + FoxFrameFlags) + 1)) << ShiftForWord))) + BytesPerWord;
+ prevFrame = aFrame;
/* begin frameCallerFP: */
aFrame = pointerForOop(longAt(aFrame + FoxSavedFP));
if (!(aFrame != 0)) break;
if (theFP == aFrame) {
- theSP = theSP1;
+ /* begin frameCallerSP: */
+ assert(!(isBaseFrame(prevFrame)));
+ theSP = (prevFrame + ((FoxCallerSavedIP + BytesPerWord) + ((byteAt((prevFrame + FoxFrameFlags) + 1)) << ShiftForWord))) + BytesPerWord;
goto l1;
}
}
@@ -23041,6 +23074,7 @@
usqLong childBytes;
sqInt f;
sqInt first;
+ sqInt fo;
sqInt freeObj;
sqInt index;
sqInt initialIndex;
@@ -23049,6 +23083,7 @@
sqInt nmisses;
sqInt node;
usqInt numSlots;
+ usqInt numSlots1;
sqInt o;
sqInt prev;
usqInt ptr;
@@ -23077,6 +23112,9 @@
&& (ptr <= ((GIV(highestObjects).last))))
|| ((((GIV(highestObjects).first)) <= ptr)
&& (ptr <= ((GIV(highestObjects).limit))))));
+ assert((GIV(firstFreeChunk) == 0)
+ || ((isFreeObject(GIV(firstFreeChunk)))
+ || (isValidClassIndex(classIndexOf(GIV(firstFreeChunk))))));
if ((((usqInt) (longAt(ptr)))) <= (((usqInt) GIV(firstFreeChunk)))) {
print("firstFitCompact fits: ");
printNum(nhits);
@@ -23261,25 +23299,30 @@
}
else {
flag("we can do better here; preferentially choosing the lowest node. That would be a form of best-fit since we are trying to compact down");
+ node = child;
+ child = longAt((node + (BaseHeaderSize)) + (3 << 2));
if (acceptedNode == 0) {
/* first search the list. */
- acceptedChunk = child;
+ acceptedChunk = node;
do {
acceptedChunk = longAt((acceptedChunk + (BaseHeaderSize)) + (0 << 2));
if ((acceptedChunk != 0)
&& (acceptedChunk < (longAt(ptr)))) {
- acceptedNode = child;
+ acceptedNode = node;
}
} while((acceptedChunk != 0)
&& (acceptedNode == 0));
if ((acceptedNode == 0)
- && (child < (longAt(ptr)))) {
- acceptedNode = child;
+ && (node < (longAt(ptr)))) {
+ acceptedNode = node;
+
+ /* break out of loop now we have an acceptedNode */
+
+ child = 0;
}
}
- child = longAt((child + (BaseHeaderSize)) + (3 << 2));
}
}
}
@@ -23336,7 +23379,30 @@
nmisses += 1;
}
else {
+
+ /* here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk
+ is a large chunk then firstFreeChunk will no longer point to an object header. So check and
+ adjust firstFreeChunk if it is assigned to. */
+
nhits += 1;
+ /* begin objectStartingAt: */
+ /* begin rawNumSlotsOf: */
+ flag("endianness");
+ numSlots1 = ((usqInt) (((usqInt)(longAt(f + 4))))) >> 24;
+ fo = (numSlots1 == 0xFF
+ ? f + (BaseHeaderSize)
+ : f);
+ if (fo == GIV(firstFreeChunk)) {
+ GIV(firstFreeChunk) = (GIV(lastSubdividedFreeChunk) == 0
+ ? objectAfter(fo)
+ : (/* begin objectStartingAt: */
+ /* begin rawNumSlotsOf: */
+ flag("endianness"),
+ (numSlots = ((usqInt) (((usqInt)(longAt(GIV(lastSubdividedFreeChunk) + 4))))) >> 24),
+ (numSlots == 0xFF
+ ? GIV(lastSubdividedFreeChunk) + (BaseHeaderSize)
+ : GIV(lastSubdividedFreeChunk))));
+ }
/* begin copyAndForward:withBytes:toFreeChunk: */
startOfObj = ((rawNumSlotsOf(longAt(ptr))) == 0xFF
? (longAt(ptr)) - (BaseHeaderSize)
@@ -23376,15 +23442,6 @@
}
}
longAtput(((longAt(ptr)) + (BaseHeaderSize)) + (0 << 2), freeObj);
- if (f == GIV(firstFreeChunk)) {
- /* begin objectStartingAt: */
- /* begin rawNumSlotsOf: */
- flag("endianness");
- numSlots = ((usqInt) (((usqInt)(longAt(f + 4))))) >> 24;
- GIV(firstFreeChunk) = (numSlots == 0xFF
- ? f + (BaseHeaderSize)
- : f);
- }
assert((GIV(lastSubdividedFreeChunk) == 0)
|| ((addressAfter(objectStartingAt(f))) == GIV(lastSubdividedFreeChunk)));
}
@@ -23406,7 +23463,7 @@
assert(GIV(totalFreeOldSpace) == (totalFreeListBytes()));
first = longAt((GIV(highestObjects).first));
assert(oopisGreaterThan(first, GIV(firstFreeChunk)));
- fillHighestObjectsWithMovableObjectsFromupTo(GIV(firstFreeChunk), first);
+ fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo(first);
} while((usedSize(&GIV(highestObjects))) > 0);
print("firstFitCompact fits: ");
printNum(nhits);
@@ -24619,6 +24676,8 @@
/* begin rawNumSlotsOf: */
flag("endianness");
rawNumSlots = ((usqInt) (((usqInt)(longAt(objOop + 4))))) >> 24;
+ assert((GIV(firstFreeChunk) == 0)
+ || (isFreeObject(GIV(firstFreeChunk))));
if (isMarked(objOop)) {
/* forwarders should have been followed in markAndTrace: */
@@ -24709,9 +24768,6 @@
l2: /* end coalesce:and: */;
next = objectAfterlimit(here, limit);
}
- if (GIV(firstFreeChunk) == 0) {
- GIV(firstFreeChunk) = here;
- }
if ((((sqInt) (bytesInObject(here)) >> 3)) >= 32) {
/* begin setFree: */
long32Atput(here, 0);
@@ -24752,6 +24808,10 @@
longAtput((here + (BaseHeaderSize)) + (0 << 2), GIV(freeLists)[index1]);
GIV(freeLists)[index1] = here;
}
+ if (GIV(firstFreeChunk) == 0) {
+ assert(isFreeObject(here));
+ GIV(firstFreeChunk) = here;
+ }
}
/* begin rawNumSlotsOf: */
@@ -24916,6 +24976,7 @@
compact();
eliminateAndFreeForwarders();
assert(validObjStacks());
+ assert(isEmptyObjStack(GIV(weaklingStack)));
assert(allObjectsUnmarked());
/* begin runLeakCheckerForFullGC: */
runLeakCheckerForFullGCexcludeUnmarkedNewSpaceObjs(1, 0);
@@ -26258,6 +26319,8 @@
GIV(markStack) = swizzleObjStackAt(MarkStackRootIndex);
GIV(weaklingStack) = swizzleObjStackAt(WeaklingStackRootIndex);
GIV(ephemeronQueue) = swizzleObjStackAt(EphemeronQueueRootIndex);
+ assert(validObjStacks());
+ assert(isEmptyObjStack(GIV(weaklingStack)));
/* begin initializeFreeSpacePostLoad: */
assert((numSlotsOf(freeListObj)) == (numFreeLists()));
assert((formatOf(freeListObj)) == (firstLongFormat()));
@@ -26780,7 +26843,18 @@
&& (((longAt(oop)) & 0x3FFFFF) == ClassMethodContextCompactIndex);
}
+static sqInt
+isEmptyObjStack(sqInt objStack)
+{ DECL_MAYBE_SQ_GLOBAL_STRUCT
+ if (objStack == GIV(nilObj)) {
+ return 1;
+ }
+ assert(isValidObjStack(objStack));
+ return (0 == (longAt((objStack + (BaseHeaderSize)) + (ObjStackTopx << 2))))
+ && (0 == (longAt((objStack + (BaseHeaderSize)) + (ObjStackNextx << 2))));
+}
+
/* Answer if objOop should be included in an allObjects...Do: enumeration.
Non-objects should be excluded; these are bridges and free chunks. */
@@ -27240,6 +27314,31 @@
}
static sqInt
+isValidClassIndex(sqInt classIndex)
+{ DECL_MAYBE_SQ_GLOBAL_STRUCT
+ sqInt classTablePage;
+
+ if (classIndex <= 0) {
+ return 0;
+ }
+ if (!((classIndex <= 3)
+ || (classIndex >= 16))) {
+ return 0;
+ }
+ if (classIndex >= (1 << 22)) {
+ return 0;
+ }
+ classTablePage = longAt((GIV(hiddenRootsObj) + (BaseHeaderSize)) + ((((usqInt) classIndex) >> 10) << 2));
+ if (classTablePage == GIV(nilObj)) {
+ return 0;
+ }
+ if (!(addressCouldBeObj(classTablePage))) {
+ 0;
+ }
+ return addressCouldBeClassObj(longAt((classTablePage + (BaseHeaderSize)) + ((classIndex & ((1 << 10) - 1)) << 2)));
+}
+
+static sqInt
isValidFreeObject(sqInt objOop)
{
sqInt chunk;
@@ -30711,18 +30810,15 @@
}
-/* Use simple algorithm by D.H. Lehmer from 1951, for now. */
+/* Use a slight variation on D.H. Lehmer's linear congruential generator from
+ 1951. See e.g. http://en.wikipedia.org/wiki/Linear_congruential_generator. */
static sqInt
newObjectHash(void)
{ DECL_MAYBE_SQ_GLOBAL_STRUCT
-
- /* 7 raisedTo: 5 */
- /* (2 raisedTo: 31) - 1 */
-
- GIV(lastHash) = (GIV(lastHash) * 16807) % 2147483645;
+ GIV(lastHash) = GIV(lastHash) * 16807;
assert(GIV(lastHash) != 0);
- return GIV(lastHash);
+ return GIV(lastHash) + (((usqInt) GIV(lastHash)) >> 8);
}
static sqInt
@@ -30777,6 +30873,9 @@
sqInt topIndex;
sqInt weakling;
+ if (GIV(weaklingStack) == GIV(nilObj)) {
+ return;
+ }
/* begin objStack:from:do: */
size = longAt((GIV(weaklingStack) + (BaseHeaderSize)) + (ObjStackTopx << 2));
objStackPage = longAt((GIV(weaklingStack) + (BaseHeaderSize)) + (ObjStackNextx << 2));
@@ -30804,6 +30903,9 @@
}
size;
/* begin emptyObjStack: */
+ if (GIV(weaklingStack) == GIV(nilObj)) {
+ goto l1;
+ }
assert(isValidObjStack(GIV(weaklingStack)));
/* begin storePointer:ofObject:withValue: */
assert(!(isForwarded(GIV(weaklingStack))));
@@ -30845,6 +30947,7 @@
null;
longAtput((GIV(weaklingStack) + (BaseHeaderSize)) + (ObjStackNextx << 2), 0);
assert(isValidObjStack(GIV(weaklingStack)));
+l1: /* end emptyObjStack: */;
}
@@ -34234,7 +34337,7 @@
}
}
/* begin pop:thenPush: */
- longAtput((sp = GIV(stackPointer) + ((1 - 1) * BytesPerWord)), newCopy);
+ longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), newCopy);
GIV(stackPointer) = sp;
}
@@ -49216,10 +49319,10 @@
{ DECL_MAYBE_SQ_GLOBAL_STRUCT
char *aFrame;
sqInt index;
+ char *prevFrame;
char *startFrame;
StackPage *thePage;
char *theSP;
- char *theSP1;
if (theFP == GIV(framePointer)) {
theSP = GIV(stackPointer);
@@ -49243,10 +49346,8 @@
? GIV(framePointer)
: (thePage->headFP));
assert(!(isFree(thePage)));
- aFrame = startFrame;
- theSP1 = (thePage->headSP);
- if (aFrame == theFP) {
- if (theSP1 >= aFrame) {
+ if (startFrame == theFP) {
+ if (((thePage->headSP)) >= startFrame) {
/* If the SP is invalid return the pointer to the receiver field. */
@@ -49255,19 +49356,20 @@
goto l1;
}
theSP = (thePage == GIV(stackPage)
- ? theSP1
- : theSP1 + BytesPerWord);
+ ? (thePage->headSP)
+ : ((thePage->headSP)) + BytesPerWord);
goto l1;
}
+ aFrame = startFrame;
while (1) {
- /* begin frameCallerSP: */
- assert(!(isBaseFrame(aFrame)));
- theSP1 = (aFrame + ((FoxCallerSavedIP + BytesPerWord) + ((byteAt((aFrame + FoxFrameFlags) + 1)) << ShiftForWord))) + BytesPerWord;
+ prevFrame = aFrame;
/* begin frameCallerFP: */
aFrame = pointerForOop(longAt(aFrame + FoxSavedFP));
if (!(aFrame != 0)) break;
if (theFP == aFrame) {
- theSP = theSP1;
+ /* begin frameCallerSP: */
+ assert(!(isBaseFrame(prevFrame)));
+ theSP = (prevFrame + ((FoxCallerSavedIP + BytesPerWord) + ((byteAt((prevFrame + FoxFrameFlags) + 1)) << ShiftForWord))) + BytesPerWord;
goto l1;
}
}
@@ -53228,6 +53330,11 @@
assert(becomeEffects & BecamePointerObjectFlag);
classObj = startClassObj;
while (1) {
+ if (!((((classObj & 3) == 0)
+ && (((((usqInt) (longAt(classObj))) >> 24) & 0x1F) <= 5))
+ && ((numSlotsOf(classObj)) > MethodDictionaryIndex))) {
+ return;
+ }
/* begin followObjField:ofObject: */
objOop1 = longAt((classObj + (BaseHeaderSize)) + (MethodDictionaryIndex << 2));
assert(isNonImmediate(objOop1));
@@ -55077,9 +55184,22 @@
{ DECL_MAYBE_SQ_GLOBAL_STRUCT
sqInt activeContext;
sqInt activeProc;
+ sqInt address;
+ sqInt bytes;
+ sqInt cameFrom;
+ SpurSegmentInfo * cascade0;
sqInt errorCode;
+ usqInt freeChunk;
+ usqInt freeChunk1;
sqInt i;
+ sqInt i1;
+ sqInt i2;
+ sqInt i3;
+ sqInt largeChild;
sqInt methodHeader;
+ sqInt newEndOfMemory;
+ sqInt newEndOfMemory1;
+ sqInt next;
sqInt numArgs;
sqInt numTemps;
sqInt object;
@@ -55087,7 +55207,9 @@
sqInt rcvr;
sqInt rcvr1;
sqInt savedTenuringThreshold;
+ SpurSegmentInfo *seg;
void *setMacType;
+ sqInt smallChild;
char *sp;
char *sp1;
char *sp11;
@@ -55100,6 +55222,7 @@
char *sp8;
sqInt stackIndex;
sqInt table;
+ sqInt treeNode;
/* For now the stack munging below doesn't deal with more than one argument.
@@ -55147,6 +55270,82 @@
assert(GIV(pastSpaceStart) == (((pastSpace()).start)));
assert(GIV(freeStart) == (((eden()).start)));
fullGC();
+ /* begin prepareForSnapshot */
+ for (i2 = 0; i2 < GIV(numSegments); i2 += 1) {
+ cascade0 = (&(GIV(segments)[i2]));
+ (cascade0->savedSegSize = ((GIV(segments)[i2]).segSize));
+ (cascade0->lastFreeObject = null);
+ }
+ /* begin freeTreeNodesDo: */
+ treeNode = GIV(freeLists)[0];
+ if (treeNode == 0) {
+ goto l2;
+ }
+ cameFrom = -1;
+ do {
+ smallChild = longAt((treeNode + (BaseHeaderSize)) + (3 << 2));
+ largeChild = longAt((treeNode + (BaseHeaderSize)) + (4 << 2));
+ assert((smallChild == 0)
+ || (treeNode == (fetchPointerofFreeChunk(freeChunkParentIndex(), smallChild))));
+ assert((largeChild == 0)
+ || (treeNode == (fetchPointerofFreeChunk(freeChunkParentIndex(), largeChild))));
+ if (((smallChild == 0)
+ && (largeChild == 0))
+ || ((largeChild == 0
+ ? cameFrom == smallChild
+ : cameFrom == largeChild))) {
+
+ /* and since we've applied we must move on up */
+
+ next = objectAfterlimit(treeNode, endOfMemory());
+ if (((longAt(next)) & 0x3FFFFF) == 3) {
+ /* begin segmentContainingObj: */
+ for (i1 = (GIV(numSegments) - 1); i1 >= 0; i1 += -1) {
+ if (treeNode >= (((GIV(segments)[i1]).segStart))) {
+ seg = (&(GIV(segments)[i1]));
+ goto l4;
+ }
+ }
+ seg = null;
+ l4: /* end segmentContainingObj: */;
+ (seg->lastFreeObject = treeNode);
+ }
+ treeNode = treeNode;
+
+ cameFrom = treeNode;
+ treeNode = longAt((treeNode + (BaseHeaderSize)) + (2 << 2));
+ }
+ else {
+ if ((smallChild != 0)
+ && (cameFrom != smallChild)) {
+ treeNode = smallChild;
+ }
+ else {
+ assert(largeChild != 0);
+ treeNode = largeChild;
+ }
+ cameFrom = -1;
+ }
+ } while(treeNode != 0);
+l2: /* end freeTreeNodesDo: */;
+ for (i2 = 0; i2 < GIV(numSegments); i2 += 1) {
+ freeChunk = ((GIV(segments)[i2]).lastFreeObject);
+ if (!(freeChunk == null)) {
+ detachFreeObject(freeChunk);
+ ((GIV(segments)[i2]).segSize = ((((rawNumSlotsOf(freeChunk)) == 0xFF
+ ? freeChunk - (BaseHeaderSize)
+ : freeChunk)) + (2 * (BaseHeaderSize))) - (((GIV(segments)[i2]).segStart)));
+ bridgeFromto((&(GIV(segments)[i2])), (i2 < (GIV(numSegments) - 1)
+ ? (&(GIV(segments)[i2 + 1]))
+ : 0));
+ }
+ }
+ /* begin setEndOfMemory: */
+ newEndOfMemory = ((((GIV(segments)[GIV(numSegments) - 1]).segSize)) + (((GIV(segments)[GIV(numSegments) - 1]).segStart))) - (2 * (BaseHeaderSize));
+ GIV(endOfMemory) = newEndOfMemory;
+ if (GIV(freeOldSpaceStart) > newEndOfMemory) {
+ GIV(freeOldSpaceStart) = newEndOfMemory;
+ }
activeContext = GIV(tempOop);
GIV(tempOop) = 0;
if (!GIV(primFailCode)) {
@@ -55179,6 +55378,27 @@
assert(!(isForwarded(activeContext)));
longAtput((activeContext + (BaseHeaderSize)) + (StackPointerIndex << 2), (((stackIndex - 1) << 1) | 1));
}
+ /* begin postSnapshot */
+ for (i3 = (GIV(numSegments) - 1); i3 >= 0; i3 += -1) {
+ freeChunk1 = ((GIV(segments)[i3]).lastFreeObject);
+ if (!(freeChunk1 == null)) {
+ address = ((((GIV(segments)[i3]).segSize)) + (((GIV(segments)[i3]).segStart))) - (2 * (BaseHeaderSize));
+ ((GIV(segments)[i3]).segSize = ((GIV(segments)[i3]).savedSegSize));
+ bridgeFromto((&(GIV(segments)[i3])), (i3 < (GIV(numSegments) - 1)
+ ? (&(GIV(segments)[i3 + 1]))
+ : 0));
+ /* begin addFreeChunkWithBytes:at: */
+ bytes = (((((GIV(segments)[i3]).segSize)) + (((GIV(segments)[i3]).segStart))) - address) - (2 * (BaseHeaderSize));
+ freeChunkWithBytesat(bytes, address);
+ GIV(totalFreeOldSpace) += bytes;
+ }
+ }
+ /* begin setEndOfMemory: */
+ newEndOfMemory1 = ((((GIV(segments)[GIV(numSegments) - 1]).segSize)) + (((GIV(segments)[GIV(numSegments) - 1]).segStart))) - (2 * (BaseHeaderSize));
+ GIV(endOfMemory) = newEndOfMemory1;
+ if (GIV(freeOldSpaceStart) > newEndOfMemory1) {
+ GIV(freeOldSpaceStart) = newEndOfMemory1;
+ }
marryContextInNewStackPageAndInitializeInterpreterRegisters(activeContext);
if (!GIV(primFailCode)) {
/* begin push: */
@@ -56322,7 +56542,7 @@
assert((numSlotsOfAny(stackOrNil)) == ObjStackPageSlots);
assert((fetchPointerofObject(ObjStackMyx, stackOrNil)) == objStackRootIndex);
- /* swizzle fields including ObjStackNextx and leave field containing the next link. */
+ /* swizzle fields including ObjStackNextx, excluding ObjStackFreex and leave field containing the next link. */
index = (longAt((stackOrNil + (BaseHeaderSize)) + (ObjStackTopx << 2))) + ObjStackNextx;
do {
@@ -56335,32 +56555,19 @@
null;
longAtput((stackOrNil + (BaseHeaderSize)) + (index << 2), field);
}
- } while(((index -= 1)) > ObjStackMyx);
+ } while(((index -= 1)) >= ObjStackNextx);
} while(((stackOrNil = field)) != 0);
if (((stackOrNil = longAt((firstPage + (BaseHeaderSize)) + (ObjStackFreex << 2)))) != 0) {
- while (1) {
- page = longAt((stackOrNil + (BaseHeaderSize)) + (ObjStackFreex << 2));
- if (!(page != 0)) break;
- field = swizzleObj(page);
+ page = firstPage;
+ do {
+ stackOrNil = swizzleObj(stackOrNil);
/* begin storePointer:ofObjStack:withValue: */
- assert((formatOf(stackOrNil)) == (wordIndexableFormat()));
+ assert((formatOf(page)) == (wordIndexableFormat()));
null;
- longAtput((stackOrNil + (BaseHeaderSize)) + (ObjStackFreex << 2), field);
- stackOrNil = field;
- }
+ longAtput((page + (BaseHeaderSize)) + (ObjStackFreex << 2), stackOrNil);
+ page = stackOrNil;
+ } while(((stackOrNil = longAt((page + (BaseHeaderSize)) + (ObjStackFreex << 2)))) != 0);
}
- if (((stackOrNil = longAt((firstPage + (BaseHeaderSize)) + (ObjStackNextx << 2)))) != 0) {
- while (1) {
- page = longAt((stackOrNil + (BaseHeaderSize)) + (ObjStackNextx << 2));
- if (!(page != 0)) break;
- field = swizzleObj(page);
- /* begin storePointer:ofObjStack:withValue: */
- assert((formatOf(stackOrNil)) == (wordIndexableFormat()));
- null;
- longAtput((stackOrNil + (BaseHeaderSize)) + (ObjStackNextx << 2), field);
- stackOrNil = field;
- }
- }
assert(isValidObjStackAt(objStackRootIndex));
return longAt((GIV(hiddenRootsObj) + (BaseHeaderSize)) + (objStackRootIndex << 2));
}
Modified: branches/Cog/nsspurstacksrc/vm/interp.c
===================================================================
--- branches/Cog/nsspurstacksrc/vm/interp.c 2014-02-18 00:00:50 UTC (rev 2868)
+++ branches/Cog/nsspurstacksrc/vm/interp.c 2014-02-20 02:06:56 UTC (rev 2869)
@@ -1,9 +1,9 @@
/* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
from
- StackInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
+ StackInterpreter VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
*/
-static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3 " __DATE__ ;
+static char __buildInfo[] = "StackInterpreter VMMaker.oscog-eem.620 uuid: 0c6991e0-acb5-4250-84d8-cdeebfac41e9 " __DATE__ ;
char *__interpBuildInfo = __buildInfo;
@@ -71,6 +71,8 @@
usqInt segSize;
sqInt swizzle;
usqInt containsPinned;
+ usqInt savedSegSize;
+ usqInt lastFreeObject;
} SpurSegmentInfo;
@@ -480,7 +482,7 @@
static sqInt fetchPointerofFreeChunk(sqInt fieldIndex, sqInt objOop);
sqInt fetchPointerofObject(sqInt fieldIndex, sqInt objOop);
static sqInt fetchStackPointerOf(sqInt aContext);
-static void fillHighestObjectsWithMovableObjectsFromupTo(sqInt startObj, sqInt limitObj);
+static void fillHighestObjectsWithMovableObjectsFromFirstFreeChunkUpTo(sqInt limitObj);
static sqInt findApplicationOfTargetMixinstartingAtBehavior(sqInt targetMixin, sqInt aBehavior);
static sqInt findClassContainingMethodstartingAt(sqInt meth, sqInt classObj);
sqInt findClassOfMethodforReceiver(sqInt meth, sqInt rcvr);
@@ -605,6 +607,7 @@
static sqInt isContextHeader(sqInt aHeader);
static sqInt isContextNonImm(sqInt oop);
static sqInt isContext(sqInt oop);
+static sqInt isEmptyObjStack(sqInt objStack);
static sqInt isEnumerableObjectNoAssert(sqInt objOop);
static sqInt isEnumerableObject(sqInt objOop);
static sqInt isEphemeron(sqInt objOop);
@@ -648,6 +651,7 @@
static sqInt isScavengeSurvivor(sqInt oop);
static sqInt isSegmentBridge(sqInt objOop);
static sqInt isSingleContext(sqInt aContext);
+static sqInt isValidClassIndex(sqInt classIndex);
static sqInt isValidFreeObject(sqInt objOop);
static sqInt isValidObjStackAt(sqInt objStackRootIndex);
static sqInt isValidObjStackPagemyIndex(sqInt objStackPage, sqInt myx);
@@ -1210,8 +1214,8 @@
_iss sqInt primFailCode;
_iss sqInt specialObjectsOop;
_iss usqInt method;
+_iss sqInt nilObj;
_iss StackPage * stackPage;
-_iss sqInt nilObj;
_iss sqInt bytecodeSetSelector;
_iss char * framePointer;
_iss sqInt argumentCount;
@@ -1227,24 +1231,24 @@
_iss sqInt trueObj;
_iss sqInt falseObj;
_iss sqInt remapBufferCount;
+_iss SpurSegmentInfo * segments;
_iss sqInt * freeLists;
_iss StackPage * pages;
-_iss SpurSegmentInfo * segments;
_iss usqInt freeListsMask;
_iss usqInt pastSpaceStart;
+_iss sqInt numSegments;
_iss char * stackMemory;
+_iss sqInt firstFreeChunk;
_iss char * stackLimit;
+_iss sqInt weaklingStack;
_iss sqInt bytesPerPage;
_iss sqInt rememberedSetSize;
_iss SpurNewSpaceSpace pastSpace;
-_iss sqInt weaklingStack;
_iss SpurContiguousObjStack unscannedEphemerons;
_iss SpurNewSpaceSpace futureSpace;
-_iss sqInt numSegments;
_iss StackPage * mostRecentlyUsedPage;
_iss sqInt classTableFirstPage;
_iss usqInt newSpaceStart;
-_iss sqInt firstFreeChunk;
_iss sqInt futureSurvivorStart;
_iss usqInt oldSpaceStart;
_iss sqInt jmpDepth;
@@ -1264,8 +1268,10 @@
_iss sqInt profileProcess;
_iss sqInt extraRootCount;
_iss sqInt invalidObjStackPage;
+_iss sqInt lastSubdividedFreeChunk;
_iss sqInt previousRememberedSetSize;
_iss unsigned char * classTableBitmap;
+_iss usqInt freeOldSpaceStart;
_iss sqInt longRunningPrimitiveCheckMethod;
_iss sqInt longRunningPrimitiveCheckSemaphore;
_iss sqInt profileMethod;
@@ -1278,12 +1284,10 @@
_iss sqInt profileSemaphore;
_iss sqInt classTableIndex;
@@ Diff output truncated at 50000 characters. @@
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.620.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.620
Author: eem
Time: 19 February 2014, 5:37:04.798 pm
UUID: 0c6991e0-acb5-4250-84d8-cdeebfac41e9
Ancestors: VMMaker.oscog-eem.619
Fix an assert fail in findSPOrNilOf:on:startingFrom:.
Fix scanClassPostBecome:effects: for the bogus temp classes the
Newspeak bootstrap creates.
=============== Diff against VMMaker.oscog-eem.619 ===============
Item was changed:
----- Method: SpurMemoryManager>>scanClassPostBecome:effects: (in category 'become implementation') -----
scanClassPostBecome: startClassObj effects: becomeEffects
"Scan a class in the class table post-become. Make sure the superclass
chain contains no forwarding pointers, and that the method dictionaries
are not forwarded either. N.B. we don't follow methods or their
methodClassAssociations since we can't guarantee that forwarders
to compiled methods are not stored in method dictionaries via at:put:
and so have to cope with forwarding pointers to compiled methods
in method dictionaries anyway. Instead the [Co]Interpreter must
follow forwarders when fetching from method dictionaries and follow
forwarders on become in the method cache and method zone."
| classObj obj |
"Algorithm depends on this to terminate loop at root of superclass chain."
self assert: (self rawHashBitsOf: nilObj) ~= 0.
self assert: (becomeEffects anyMask: BecamePointerObjectFlag). "otherwise why bother?"
classObj := startClassObj.
+ ["e.g. the Newspeak bootstrap creates fake classes that contain bogus superclasses.
+ Hence be cautious."
+ ((self isPointers: classObj)
+ and: [(self numSlotsOf: classObj) > MethodDictionaryIndex]) ifFalse:
+ [^self].
+ obj := self followObjField: MethodDictionaryIndex ofObject: classObj.
- [obj := self followObjField: MethodDictionaryIndex ofObject: classObj.
"Solving the becommed method stored into a method dictionary object issue is
easy; just have a read barrier on fetching the method. But solving the read barrier
for selectors is more difficult (because selectors are currently not read, just their
+ oops). For now punt on the issue and simply follow all selectors on become"
- oops. For now punt on the issue and simply follow all selectors on become"
self flag: 'need to fix the selector and methodDictionary issue'.
true
ifTrue: [self followForwardedObjectFields: obj toDepth: 0]
ifFalse: [self followObjField: MethodArrayIndex ofObject: obj].
obj := self followObjField: SuperclassIndex ofObject: classObj.
"If the superclass has an identityHash then either it is nil, or is in the class table.
Tail recurse."
(self rawHashBitsOf: obj) = 0] whileTrue:
["effectively self scanClassPostBecome: obj"
classObj := obj]!
Item was changed:
----- Method: StackInterpreter>>findSPOrNilOf:on:startingFrom: (in category 'frame access') -----
findSPOrNilOf: theFP on: thePage startingFrom: startFrame
"Search for the stack pointer for theFP. This points to the hottest item on the frame's stack.
DO NOT CALL THIS WITH theFP == localFP OR theFP == framePointer!!"
- <var: #aFrame type: #'char *'>
<var: #theFP type: #'char *'>
<var: #thePage type: #'StackPage *'>
+ <var: #startFrame type: #'char *'>
<returnTypeC: #'char *'>
+ | aFrame prevFrame |
- | aFrame theSP |
<inline: true>
<asmLabel: false>
+ <var: #aFrame type: #'char *'>
+ <var: #prevFrame type: #'char *'>
- <var: #startFrame type: #'char *'>
- <var: #theSP type: #'char *'>
self assert: (stackPages isFree: thePage) not.
+ startFrame = theFP ifTrue:
+ [thePage headSP >= startFrame ifTrue:
- aFrame := startFrame.
- theSP := thePage headSP.
- aFrame = theFP ifTrue:
- [theSP >= aFrame ifTrue:
["If the SP is invalid return the pointer to the receiver field."
^self frameReceiverOffset: aFrame].
"Skip the instruction pointer on top of stack of inactive pages."
^thePage = stackPage
+ ifTrue: [thePage headSP]
+ ifFalse: [thePage headSP + BytesPerWord]].
+ aFrame := startFrame.
+ [prevFrame := aFrame.
- ifTrue: [theSP]
- ifFalse: [theSP + BytesPerWord]].
- [theSP := self frameCallerSP: aFrame.
aFrame := self frameCallerFP: aFrame.
aFrame ~= 0] whileTrue:
[theFP = aFrame ifTrue:
+ [^self frameCallerSP: prevFrame]].
- [^theSP]].
^nil!
1
0