[Vm-dev] VM Maker: VMMaker.oscog-eem.357.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Sep 9 19:35:41 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.357.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.357
Author: eem
Time: 9 September 2013, 12:31:51.933 pm
UUID: 2539f153-2471-4667-a8b7-2a49344be2a2
Ancestors: VMMaker.oscog-eem.356
SpurMemoryManager:
Implement instantiateClass:.
Implement checkForLastObjectOverwrite.
Introduce hasSpurMemoryManagerAPI and rewrite
primitiveNew to switch-hit.
Move StackInterpreter's [check]oopHasOkayClass: to ObjectMemory
(methods know about class format).
Refactor CurrentImageCoInterpreterFacade so V3-specific stuff is in
CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation.
=============== Diff against VMMaker.oscog-eem.356 ===============
Item was changed:
----- Method: CoInterpreter>>checkOkayFields: (in category 'debug support') -----
checkOkayFields: oop
"Check if the argument is an ok object.
If this is a pointers object, check that its fields are all okay oops."
| hasYoung i fieldOop |
(oop = nil or: [oop = 0]) ifTrue: [ ^true ]. "?? eem 1/16/2013"
(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
(objectMemory checkOkayOop: oop) ifFalse: [ ^false ].
+ (objectMemory checkOopHasOkayClass: oop) ifFalse: [ ^false ].
- (self checkOopHasOkayClass: oop) ifFalse: [ ^false ].
((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
hasYoung := objectMemory isYoung: (objectMemory fetchClassOfNonImm: oop).
(objectMemory isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart - 1]
ifFalse:
[(objectMemory isContext: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
[i >= 0] whileTrue:
[fieldOop := objectMemory fetchPointer: i ofObject: oop.
(objectMemory isNonIntegerObject: fieldOop) ifTrue:
[(i = 0 and: [objectMemory isCompiledMethod: oop])
ifTrue:
[(cogMethodZone methodFor: (self pointerForOop: fieldOop)) = 0 ifTrue:
[self print: 'method '; printHex: oop; print: ' has an invalid cog method reference'.
^false]]
ifFalse:
[hasYoung := hasYoung or: [objectMemory isYoung: fieldOop].
(objectMemory checkOkayOop: fieldOop) ifFalse: [ ^false ].
(self checkOopHasOkayClass: fieldOop) ifFalse: [ ^false ]]].
i := i - 1].
hasYoung ifTrue:
[^objectMemory checkOkayYoungReferrer: oop].
^true!
Item was changed:
----- Method: CurrentImageCoInterpreterFacade>>characterTable (in category 'accessing') -----
characterTable
+ ^self subclassResponsibility!
- ^self oopForObject: Character characterTable!
Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>compactClassTable (in category 'accessing') -----
- compactClassTable
- ^self oopForObject: Smalltalk compactClassesArray!
Item was changed:
----- Method: CurrentImageCoInterpreterFacade>>formatOfClass: (in category 'accessing') -----
+ formatOfClass: classOop
+ ^self subclassResponsibility!
- formatOfClass: classOop
- ^(self objectForOop: classOop) format << 1!
Item was changed:
----- Method: CurrentImageCoInterpreterFacade>>objectRepresentationClass (in category 'accessing') -----
objectRepresentationClass
+ ^self subclassResponsibility!
- ^CogObjectRepresentationForSqueakV3!
Item was changed:
----- Method: CurrentImageCoInterpreterFacade>>youngStartAddress (in category 'accessing') -----
youngStartAddress
+ ^self subclassResponsibility!
- ^16r4E5E400!
Item was added:
+ CurrentImageCoInterpreterFacade subclass: #CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Support'!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation>>characterTable (in category 'accessing') -----
+ characterTable
+ ^self oopForObject: Character characterTable!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation>>formatOfClass: (in category 'accessing') -----
+ formatOfClass: classOop
+ ^(self objectForOop: classOop) format << 1!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation>>objectRepresentationClass (in category 'accessing') -----
+ objectRepresentationClass
+ ^CogObjectRepresentationForSqueakV3!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation>>youngStartAddress (in category 'accessing') -----
+ youngStartAddress
+ ^16r4E5E400!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveNew (in category 'object access primitives') -----
primitiveNew
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ ["Allocate a new fixed-size instance. Fail if the allocation would leave
+ less than lowSpaceThreshold bytes free. This *will not* cause a GC :-)"
+ (objectMemory instantiateClass: self stackTop)
+ ifNotNil: [:obj| self pop: argumentCount + 1 thenPush: obj]
+ ifNil: [self primitiveFailFor: PrimErrNoMemory]]
+ ifFalse:
+ ["Allocate a new fixed-size instance. Fail if the allocation would leave
+ less than lowSpaceThreshold bytes free. May cause a GC."
+ | spaceOkay |
+ "The following may cause GC!! Use var for result to permit inlining."
+ spaceOkay := objectMemory
+ sufficientSpaceToInstantiate: self stackTop
+ indexableSize: 0.
+ spaceOkay
+ ifTrue:
+ [self
+ pop: argumentCount + 1
+ thenPush: (objectMemory
+ instantiateClass: self stackTop
+ indexableSize: 0)]
+ ifFalse: [self primitiveFailFor: PrimErrNoMemory]]!
- "Allocate a new fixed-size instance. Fail if the allocation would leave less than lowSpaceThreshold bytes free. May cause a GC."
- | spaceOkay |
- "The following may cause GC!!"
- spaceOkay := objectMemory sufficientSpaceToInstantiate: self stackTop indexableSize: 0.
- spaceOkay ifTrue: [self
- pop: argumentCount + 1
- thenPush: (objectMemory instantiateClass: self stackTop indexableSize: 0)]
- ifFalse: [self primitiveFailFor: PrimErrNoMemory]!
Item was added:
+ ----- Method: ObjectMemory>>checkOopHasOkayClass: (in category 'debug support') -----
+ checkOopHasOkayClass: obj
+ "Attempt to verify that the given obj has a reasonable behavior. The class must be a
+ valid, non-integer oop and must not be nilObj. It must be a pointers object with three
+ or more fields. Finally, the instance specification field of the behavior must match that
+ of the instance. If OK answer true. If not, print reason and answer false."
+
+ <api>
+ <var: #oop type: #usqInt>
+ | objClass formatMask behaviorFormatBits objFormatBits |
+ <var: #oopClass type: #usqInt>
+
+ (self checkOkayOop: obj) ifFalse:
+ [^false].
+ objClass := self cCoerce: (self fetchClassOfNonImm: obj) to: #usqInt.
+
+ (self isIntegerObject: objClass) ifTrue:
+ [self print: 'obj '; printHex: obj; print: ' a SmallInteger is not a valid class or behavior'; cr. ^false].
+ (self okayOop: objClass) ifFalse:
+ [self print: 'obj '; printHex: obj; print: ' class obj is not ok'; cr. ^false].
+ ((self isPointersNonInt: objClass) and: [(self lengthOf: objClass) >= 3]) ifFalse:
+ [self print: 'obj '; printHex: obj; print: ' a class (behavior) must be a pointers object of size >= 3'; cr. ^false].
+ formatMask := (self isBytes: obj)
+ ifTrue: [16rC00] "ignore extra bytes size bits"
+ ifFalse: [16rF00].
+
+ behaviorFormatBits := (self formatOfClass: objClass) bitAnd: formatMask.
+ objFormatBits := (self baseHeader: obj) bitAnd: formatMask.
+ behaviorFormatBits = objFormatBits ifFalse:
+ [self print: 'obj '; printHex: obj; print: ' and its class (behavior) formats differ'; cr. ^false].
+ ^true!
Item was added:
+ ----- Method: ObjectMemory>>hasSpurMemoryManagerAPI (in category 'api characterization') -----
+ hasSpurMemoryManagerAPI
+ ^false!
Item was added:
+ ----- Method: ObjectMemory>>oopHasOkayClass: (in category 'debug support') -----
+ oopHasOkayClass: signedOop
+ "Attempt to verify that the given oop has a reasonable behavior. The class must be a valid, non-integer oop and must not be nilObj. It must be a pointers object with three or more fields. Finally, the instance specification field of the behavior must match that of the instance."
+
+ | oop oopClass formatMask behaviorFormatBits oopFormatBits |
+ <var: #oop type: #usqInt>
+ <var: #oopClass type: #usqInt>
+
+ oop := self cCoerce: signedOop to: #usqInt.
+ self okayOop: oop.
+ oopClass := self cCoerce: (self fetchClassOf: oop) to: #usqInt.
+
+ (self isIntegerObject: oopClass)
+ ifTrue: [ self error: 'a SmallInteger is not a valid class or behavior'. ^false ].
+ (self okayOop: oopClass)
+ ifFalse: [ self error: 'class oop is not ok'. ^false ].
+ ((self isPointersNonInt: oopClass) and: [(self lengthOf: oopClass) >= 3])
+ ifFalse: [ self error: 'a class (behavior) must be a pointers object of size >= 3'. ^false ].
+ (self isBytes: oop)
+ ifTrue: [ formatMask := 16rC00 ] "ignore extra bytes size bits"
+ ifFalse: [ formatMask := 16rF00 ].
+
+ behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
+ oopFormatBits := (self baseHeader: oop) bitAnd: formatMask.
+ behaviorFormatBits = oopFormatBits
+ ifFalse: [ self error: 'object and its class (behavior) formats differ'. ^false ].
+ ^true!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>fillObj:numSlots:with: (in category 'allocation') -----
+ fillObj: objOop numSlots: numSlots with: fillValue
+ objOop + self baseHeaderSize
+ to: objOop + self baseHeaderSize + (numSlots * 4)
+ by: self allocationUnit
+ do: [:p|
+ self longAt: p put: fillValue;
+ longAt: p + 4 put: fillValue]!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>initSpaceForAllocationCheck: (in category 'allocation') -----
+ initSpaceForAllocationCheck: aNewSpace
+ CheckObjectOverwrite ifTrue:
+ [aNewSpace start
+ to: aNewSpace limit
+ by: self wordSize
+ do: [:p| self longAt: p put: p]]!
Item was changed:
----- Method: SpurGenerationScavenger>>manager:memory:newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') -----
manager: aSpurMemoryManager memory: memoryArray newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes
| edenBytes edenLimit edenStart survivorBytes |
manager := aSpurMemoryManager.
memory := memoryArray.
edenBytes := requestedEdenBytes.
edenStart := startAddress.
survivorBytes := totalBytes - edenBytes // 2 truncateTo: manager allocationUnit.
edenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
edenLimit := edenStart + edenBytes roundUpTo: manager allocationUnit.
self assert: totalBytes - (edenLimit - edenStart) - survivorBytes - survivorBytes < manager allocationUnit.
eden := SpurNewSpaceSpace new.
pastSpace := SpurNewSpaceSpace new.
futureSpace := SpurNewSpaceSpace new.
eden start: edenStart limit: edenLimit.
pastSpace start: edenLimit limit: edenLimit + survivorBytes.
futureSpace start: pastSpace limit limit: pastSpace limit + survivorBytes.
self assert: futureSpace limit <= (startAddress + totalBytes).
self assert: eden start \\ manager allocationUnit
+ (eden limit \\ manager allocationUnit) = 0.
self assert: pastSpace start \\ manager allocationUnit
+ (pastSpace limit \\ manager allocationUnit) = 0.
self assert: futureSpace start \\ manager allocationUnit
+ (futureSpace limit \\ manager allocationUnit) = 0.
+ self initPastSpaceForObjectEnumeration.
+ manager initSpaceForAllocationCheck: eden!
- self initPastSpaceForObjectEnumeration!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
initialize
"CogObjectMemory initialize"
+ NumFreeLists := 65. "One for each size up to and including 64 slots. One for sizes > 64 slots."
+ CheckObjectOverwrite := true!
- NumFreeLists := 65 "One for each size up to and including 64 slots. One for sizes > 64 slots."!
Item was added:
+ ----- Method: SpurMemoryManager>>checkForLastObjectOverwrite (in category 'allocation') -----
+ checkForLastObjectOverwrite
+ <doNotGenerate>
+ self assert: (freeStart >= scavengeThreshold
+ or: [CheckObjectOverwrite not
+ or: [(self longAt: freeStart) = freeStart]])!
Item was added:
+ ----- Method: SpurMemoryManager>>ephemeronFormat (in category 'header format') -----
+ ephemeronFormat
+ ^5!
Item was added:
+ ----- Method: SpurMemoryManager>>fillObj:numSlots:with: (in category 'allocation') -----
+ fillObj: objOop numSlots: numSlots with: fillValue
+ self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>fixedFieldsFieldWidth (in category 'object format') -----
+ fixedFieldsFieldWidth
+ ^16!
Item was changed:
----- Method: SpurMemoryManager>>fixedFieldsOf:format:length: (in category 'object format') -----
fixedFieldsOf: objOop format: fmt length: wordLength
+ | class |
- "
- NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
- When we revise the image format, it should become...
- ^ (classFormat >> 2 bitAnd: 16rFF) - 1
- "
- | class classFormat |
<inline: true>
<asmLabel: false>
+ (fmt > self ephemeronFormat or: [fmt = 2]) ifTrue: [^0]. "indexable fields only"
- ((fmt > 4) or: [fmt = 2]) ifTrue: [^0]. "indexable fields only"
fmt < 2 ifTrue: [^wordLength]. "fixed fields only (zero or more)"
- self flag: #fixme. "Must munge class formats now..."
- "fmt = 3 or 4: mixture of fixed and indexable fields, so must look at class format word"
class := self fetchClassOfNonImm: objOop.
+ ^self fixedFieldsOfClassFormat: (self formatOfClass: class)!
- classFormat := self formatOfClass: class.
- ^(classFormat >> 11 bitAnd: 16rC0) + (classFormat >> 2 bitAnd: 16r3F) - 1!
Item was added:
+ ----- Method: SpurMemoryManager>>fixedFieldsOfClassFormat: (in category 'object format') -----
+ fixedFieldsOfClassFormat: classFormat
+ ^classFormat bitAnd: self fixedFieldsOfClassFormatMask!
Item was added:
+ ----- Method: SpurMemoryManager>>fixedFieldsOfClassFormatMask (in category 'object format') -----
+ fixedFieldsOfClassFormatMask
+ ^1 << self fixedFieldsFieldWidth - 1!
Item was added:
+ ----- Method: SpurMemoryManager>>formatOfClass: (in category 'object format') -----
+ formatOfClass: classPointer
+ <api>
+ <inline: true>
+ ^self integerValueOf: (self fetchPointer: InstanceSpecificationIndex ofObject: classPointer)!
Item was added:
+ ----- Method: SpurMemoryManager>>hasSpurMemoryManagerAPI (in category 'api characterization') -----
+ hasSpurMemoryManagerAPI
+ ^true!
Item was added:
+ ----- Method: SpurMemoryManager>>initSpaceForAllocationCheck: (in category 'allocation') -----
+ initSpaceForAllocationCheck: aNewSpace
+ self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>instSpecOfClassFormat: (in category 'object format') -----
+ instSpecOfClassFormat: classFormat
+ ^classFormat >> self fixedFieldsFieldWidth bitAnd: self formatMask!
Item was added:
+ ----- Method: SpurMemoryManager>>instantiateClass: (in category 'allocation') -----
+ instantiateClass: classObj
+ | instSpec classFormat numSlots classIndex newObj |
+ classFormat := self formatOfClass: classObj.
+ instSpec := self instSpecOfClassFormat: classFormat.
+ (self isFixedSizePointerFormat: instSpec) ifFalse:
+ [^nil].
+ classIndex := self hashBitsOf: classObj.
+ classIndex = 0 ifTrue:
+ [(self enterIntoClassTable: classObj) ifFalse:
+ [^nil].
+ classIndex := self hashBitsOf: classObj].
+ numSlots := self fixedFieldsOfClassFormat: classFormat.
+ newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
+ newObj ifNotNil:
+ [self fillObj: newObj numSlots: numSlots with: nilObj].
+ ^newObj!
Item was added:
+ ----- Method: SpurMemoryManager>>isFixedSizePointerFormat: (in category 'header format') -----
+ isFixedSizePointerFormat: format
+ ^format <= self nonIndexablePointerFormat
+ or: [format = self ephemeronFormat]!
Item was added:
+ ----- Method: SpurMemoryManager>>nonIndexablePointerFormat (in category 'header format') -----
+ nonIndexablePointerFormat
+ ^2!
Item was added:
+ ----- Method: SpurMemoryManager>>sufficientSpaceToInstantiate:indexableSize: (in category 'allocation') -----
+ sufficientSpaceToInstantiate: classObj indexableSize: indexableFields
+ self shouldNotImplement!
Item was changed:
----- Method: StackInterpreter>>checkOkayFields: (in category 'debug support') -----
checkOkayFields: oop
"Check if the argument is an ok object.
If this is a pointers object, check that its fields are all okay oops."
| hasYoung i fieldOop |
(oop = nil or: [oop = 0]) ifTrue: [ ^true ]. "?? eem 1/16/2013"
(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
(objectMemory checkOkayOop: oop) ifFalse: [ ^false ].
+ (objectMemory checkOopHasOkayClass: oop) ifFalse: [ ^false ].
- (self checkOopHasOkayClass: oop) ifFalse: [ ^false ].
((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
hasYoung := objectMemory isYoung: (objectMemory fetchClassOfNonImm: oop).
(objectMemory isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart - 1]
ifFalse:
[(objectMemory isContext: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
[i >= 0] whileTrue:
[fieldOop := objectMemory fetchPointer: i ofObject: oop.
(objectMemory isIntegerObject: fieldOop) ifFalse:
[hasYoung := hasYoung or: [objectMemory isYoung: fieldOop].
(objectMemory checkOkayOop: fieldOop) ifFalse: [ ^false ].
(self checkOopHasOkayClass: fieldOop) ifFalse: [ ^false ]].
i := i - 1].
hasYoung ifTrue:
[^objectMemory checkOkayYoungReferrer: oop].
^true!
Item was removed:
- ----- Method: StackInterpreter>>checkOopHasOkayClass: (in category 'debug support') -----
- checkOopHasOkayClass: obj
- "Attempt to verify that the given obj has a reasonable behavior. The class must be a
- valid, non-integer oop and must not be nilObj. It must be a pointers object with three
- or more fields. Finally, the instance specification field of the behavior must match that
- of the instance. If OK answer true. If not, print reason and answer false."
-
- <api>
- <var: #oop type: #usqInt>
- | objClass formatMask behaviorFormatBits objFormatBits |
- <var: #oopClass type: #usqInt>
-
- (objectMemory checkOkayOop: obj) ifFalse:
- [^false].
- objClass := self cCoerce: (objectMemory fetchClassOfNonImm: obj) to: #usqInt.
-
- (objectMemory isIntegerObject: objClass) ifTrue:
- [self print: 'obj '; printHex: obj; print: ' a SmallInteger is not a valid class or behavior'; cr. ^false].
- (objectMemory okayOop: objClass) ifFalse:
- [self print: 'obj '; printHex: obj; print: ' class obj is not ok'; cr. ^false].
- ((objectMemory isPointersNonInt: objClass) and: [(objectMemory lengthOf: objClass) >= 3]) ifFalse:
- [self print: 'obj '; printHex: obj; print: ' a class (behavior) must be a pointers object of size >= 3'; cr. ^false].
- formatMask := (objectMemory isBytes: obj)
- ifTrue: [16rC00] "ignore extra bytes size bits"
- ifFalse: [16rF00].
-
- behaviorFormatBits := (objectMemory formatOfClass: objClass) bitAnd: formatMask.
- objFormatBits := (objectMemory baseHeader: obj) bitAnd: formatMask.
- behaviorFormatBits = objFormatBits ifFalse:
- [self print: 'obj '; printHex: obj; print: ' and its class (behavior) formats differ'; cr. ^false].
- ^true!
Item was changed:
----- Method: StackInterpreter>>okayFields: (in category 'debug support') -----
okayFields: oop
"Check if the argument is an ok object.
If this is a pointers object, check that its fields are all okay oops."
| i fieldOop |
(oop = nil or: [oop = 0]) ifTrue: [ ^true ].
(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
(objectMemory okayOop: oop) ifFalse: [ ^false ].
+ (objectMemory oopHasOkayClass: oop) ifFalse: [ ^false ].
- (self oopHasOkayClass: oop) ifFalse: [ ^false ].
((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
(objectMemory isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart - 1]
ifFalse:
[(objectMemory isContext: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
[i >= 0] whileTrue: [
fieldOop := objectMemory fetchPointer: i ofObject: oop.
(objectMemory isIntegerObject: fieldOop) ifFalse: [
(objectMemory okayOop: fieldOop) ifFalse: [ ^false ].
(self oopHasOkayClass: fieldOop) ifFalse: [ ^false ].
].
i := i - 1.
].
^true!
Item was removed:
- ----- Method: StackInterpreter>>oopHasOkayClass: (in category 'debug support') -----
- oopHasOkayClass: signedOop
- "Attempt to verify that the given oop has a reasonable behavior. The class must be a valid, non-integer oop and must not be nilObj. It must be a pointers object with three or more fields. Finally, the instance specification field of the behavior must match that of the instance."
-
- | oop oopClass formatMask behaviorFormatBits oopFormatBits |
- <var: #oop type: #usqInt>
- <var: #oopClass type: #usqInt>
-
- oop := self cCoerce: signedOop to: #usqInt.
- objectMemory okayOop: oop.
- oopClass := self cCoerce: (objectMemory fetchClassOf: oop) to: #usqInt.
-
- (objectMemory isIntegerObject: oopClass)
- ifTrue: [ self error: 'a SmallInteger is not a valid class or behavior'. ^false ].
- (objectMemory okayOop: oopClass)
- ifFalse: [ self error: 'class oop is not ok'. ^false ].
- ((objectMemory isPointersNonInt: oopClass) and: [(objectMemory lengthOf: oopClass) >= 3])
- ifFalse: [ self error: 'a class (behavior) must be a pointers object of size >= 3'. ^false ].
- (objectMemory isBytes: oop)
- ifTrue: [ formatMask := 16rC00 ] "ignore extra bytes size bits"
- ifFalse: [ formatMask := 16rF00 ].
-
- behaviorFormatBits := (objectMemory formatOfClass: oopClass) bitAnd: formatMask.
- oopFormatBits := (objectMemory baseHeader: oop) bitAnd: formatMask.
- behaviorFormatBits = oopFormatBits
- ifFalse: [ self error: 'object and its class (behavior) formats differ'. ^false ].
- ^true!
More information about the Vm-dev
mailing list