The Inbox: Mirrors-cwp.2.mcz

A new version of Mirrors was added to project The Inbox:
http://source.squeak.org/inbox/Mirrors-cwp.2.mcz

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

Name: Mirrors-cwp.2
Author: cwp
Time: 15 May 2012, 6:50:25.515 pm
UUID: 48ba5f51-623b-4e6f-9b64-47c2c3e43258
Ancestors: Mirrors-cwp.1

Implemented a simple non-invasive inspector.

==================== Snapshot ====================

SystemOrganization addCategory: #'Mirrors-Tests'!
SystemOrganization addCategory: #'Mirrors-Object'!
SystemOrganization addCategory: #'Mirrors-Utilities'!

nil subclass: #MessageShunt
        instanceVariableNames: 'handler'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Utilities'!

----- Method: MessageShunt class>>handler: (in category 'as yet unclassified') -----
handler: aBlock
        | inst |
        inst := self basicNew.
        CompiledMethod
                receiver: inst
                withArguments: {1. aBlock}
                executeMethod: (Reflection compiledMethodAt: #fixedAt:put:).
        ^ inst!

----- Method: MessageShunt class>>initialize (in category 'as yet unclassified') -----
initialize
        self superclass: nil!

----- Method: MessageShunt>>doesNotUnderstand: (in category 'as yet unclassified') -----
doesNotUnderstand: aMessage
        handler value: aMessage!

TestCase subclass: #FixedSlotMirrorTest
        instanceVariableNames: 'mirror four'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Tests'!

----- Method: FixedSlotMirrorTest>>instVarAt: (in category 'shunts') -----
instVarAt: anIndex
        "We don't want the slot mirror sending #instVarAt:, so if it does, fail the test"
       
        self assert: false!

----- Method: FixedSlotMirrorTest>>instVarAt:put: (in category 'shunts') -----
instVarAt: anIndex put: anObject
        "We don't want mirrors sending #instVarAt:put:, so if it does, fail the test"
       
        self assert: false!

----- Method: FixedSlotMirrorTest>>setUp (in category 'running') -----
setUp
        mirror := FixedSlotMirror on: self index: 4.
        !

----- Method: FixedSlotMirrorTest>>testName (in category 'tests') -----
testName
        self assert: mirror name = 'four'!

----- Method: FixedSlotMirrorTest>>testRead (in category 'tests') -----
testRead
        four := Object new.
        self assert: mirror value == four!

----- Method: FixedSlotMirrorTest>>testWrite (in category 'tests') -----
testWrite
        | value |
        value := Object new.
        mirror value: value.
        self assert: four == value!

TestCase subclass: #ObjectMirrorTest1
        instanceVariableNames: 'mirror four'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Tests'!

----- Method: ObjectMirrorTest1>>setFour (in category 'support') -----
setFour
        four := #four!

----- Method: ObjectMirrorTest1>>setUp (in category 'running') -----
setUp
        mirror := ObjectMirror on: self!

----- Method: ObjectMirrorTest1>>tearDown (in category 'running') -----
tearDown
        mirror := nil.
        four := nil.!

----- Method: ObjectMirrorTest1>>testPerformWithNoArguments (in category 'tests') -----
testPerformWithNoArguments
        mirror perform: #setFour arguments: #().
        self assert: four = #four!

----- Method: ObjectMirrorTest1>>testReflects (in category 'tests') -----
testReflects
        self assert: (mirror reflects: self)!

----- Method: ObjectMirrorTest1>>testSize (in category 'tests') -----
testSize
        | expected actual |
        expected := 4.
        actual := mirror size.
        self assert: actual = expected!

----- Method: ObjectMirrorTest1>>testSlotAt (in category 'tests') -----
testSlotAt
        | slot |
        slot := mirror slotAt: 1.
        self assert: slot value = #testSlotAt!

----- Method: ObjectMirrorTest1>>testSlotAtIfAbsent (in category 'tests') -----
testSlotAtIfAbsent
        | marker actual |
        marker := Object new.
        actual := mirror slotAt: 1 ifAbsent: [marker].
        self deny: actual == marker!

----- Method: ObjectMirrorTest1>>testSlotAtIfAbsentIfPresent (in category 'tests') -----
testSlotAtIfAbsentIfPresent
       
        | answer slot |
        answer := mirror slotAt: 1
                ifPresent: [:val | slot := val. #present]
                ifAbsent: [#absent].
        self assert: slot value == #testSlotAtIfAbsentIfPresent.
        self assert: answer == #present!

----- Method: ObjectMirrorTest1>>testSlotAtIfAbsentIfPresentNot (in category 'tests') -----
testSlotAtIfAbsentIfPresentNot
       
        | answer value |
        answer := mirror slotAt: 10
                ifPresent: [:val | value := val. #present]
                ifAbsent: [#absent].
        self assert: value isNil.
        self assert: answer == #absent!

----- Method: ObjectMirrorTest1>>testSlotAtIfAbsentNot (in category 'tests') -----
testSlotAtIfAbsentNot
        | marker actual |
        marker := Object new.
        actual := mirror slotAt: 10 ifAbsent: [marker].
        self assert: actual == marker!

----- Method: ObjectMirrorTest1>>testSlotAtIfPresent (in category 'tests') -----
testSlotAtIfPresent
        | slot |
        mirror slotAt: 1 ifPresent: [:s | slot := s].
        self assert: slot value == #testSlotAtIfPresent!

----- Method: ObjectMirrorTest1>>testSlotAtIfPresentNot (in category 'tests') -----
testSlotAtIfPresentNot
        | value answer |
        answer := mirror slotAt: 10 ifPresent: [:val | value := val].
        self assert: value isNil.
        self assert: answer isNil!

----- Method: ObjectMirrorTest1>>testSlots (in category 'tests') -----
testSlots
        | slots |
        slots := mirror slots.
        self assert: slots size = mirror size.
        slots do: [:ea | self assert: (ea isKindOf: FixedSlotMirror)]!

----- Method: ObjectMirrorTest1>>testUnderstands (in category 'tests') -----
testUnderstands
        self assert: (mirror understands: #testUnderstands)!

----- Method: ObjectMirrorTest1>>testUnderstandsNot (in category 'tests') -----
testUnderstandsNot
        self deny: (mirror understands: #thisSelectorIsNotImplemented)!

----- Method: ObjectMirrorTest1>>testUnderstandsSuper (in category 'tests') -----
testUnderstandsSuper
        self assert: (mirror understands: #runCase)!

TestCase subclass: #ObjectMirrorTest2
        instanceVariableNames: 'mirror handler shunt'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Tests'!

----- Method: ObjectMirrorTest2>>setUpFailShunt (in category 'as yet unclassified') -----
setUpFailShunt
        handler := [ :m | self assert: false ].
        shunt := MessageShunt handler: handler.
        mirror := ObjectMirror on: shunt!

----- Method: ObjectMirrorTest2>>testPerformSendsOneMessage (in category 'as yet unclassified') -----
testPerformSendsOneMessage
        handler := [:message | self assert: message selector = #griffle].
        shunt := MessageShunt handler: handler.
        mirror := ObjectMirror on: shunt.
        mirror perform: #griffle arguments: #().
        !

----- Method: ObjectMirrorTest2>>testSlotAtSendsNoMessages (in category 'as yet unclassified') -----
testSlotAtSendsNoMessages
        | slot |
        self setUpFailShunt.
        slot := mirror slotAt: 1.
        self assert: slot value == handler!

----- Method: ObjectMirrorTest2>>testUnderstandsSendsNoMessages (in category 'as yet unclassified') -----
testUnderstandsSendsNoMessages
        self setUpFailShunt.
        self deny: (mirror understands: #griffle)
        !

TestCase subclass: #ObjectMirrorTest3
        instanceVariableNames: 'mirror array'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Tests'!

----- Method: ObjectMirrorTest3>>setUp (in category 'as yet unclassified') -----
setUp
        array := {#one. #two. #three}.
        mirror := ObjectMirror on: array!

----- Method: ObjectMirrorTest3>>testSlotAt (in category 'as yet unclassified') -----
testSlotAt
        | slot |
        slot := mirror slotAt: 1.
        self assert: slot value = #one!

TestCase subclass: #ObjectMirrorTest4
        instanceVariableNames: 'mirror object'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Tests'!

----- Method: ObjectMirrorTest4>>setUp (in category 'as yet unclassified') -----
setUp
        object := (SparseLargeArray new: 3)
                at: 1 put: #one;
                at: 2 put: #two;
                at: 3 put: #three;
                yourself.
        mirror := ObjectMirror on: object!

----- Method: ObjectMirrorTest4>>testFixedSlotAt (in category 'as yet unclassified') -----
testFixedSlotAt
        | slot |
        slot := mirror slotAt: 2.
        self assert: slot value = 3!

----- Method: ObjectMirrorTest4>>testVariableSlotAt (in category 'as yet unclassified') -----
testVariableSlotAt
        | slot |
        slot := mirror slotAt: 6.
        self assert: slot value = #(one two three)!

TestCase subclass: #ObjectVmMirrorTest1
        instanceVariableNames: 'mirror four'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Tests'!

----- Method: ObjectVmMirrorTest1>>four: (in category 'accessing') -----
four: anObject
        four := anObject!

----- Method: ObjectVmMirrorTest1>>setUp (in category 'running') -----
setUp
        mirror := ObjectVmMirror on: self!

----- Method: ObjectVmMirrorTest1>>testFixedAt (in category 'tests') -----
testFixedAt
        four := Object new.
        self assert: (mirror fixedAt: 4) == four!

----- Method: ObjectVmMirrorTest1>>testFixedAtPut (in category 'tests') -----
testFixedAtPut
        | tmp |
        tmp := Object new.
        mirror fixedAt: 4 put: tmp.
        self assert: four == tmp!

----- Method: ObjectVmMirrorTest1>>testFixedSize (in category 'tests') -----
testFixedSize
        self assert: mirror fixedSize = 4!

----- Method: ObjectVmMirrorTest1>>testPerform (in category 'tests') -----
testPerform
        | tmp |
        tmp := Object new.
        mirror perform: #four: arguments: {tmp}.
        self assert: four == tmp!

----- Method: ObjectVmMirrorTest1>>testReflects (in category 'tests') -----
testReflects
        self assert: (mirror reflects: self)!

TestCase subclass: #ObjectVmMirrorTest2
        instanceVariableNames: 'mirror array'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Tests'!

----- Method: ObjectVmMirrorTest2>>setUp (in category 'as yet unclassified') -----
setUp
        array := #(one two three).
        mirror := ObjectVmMirror on: array!

----- Method: ObjectVmMirrorTest2>>testVariableAt (in category 'as yet unclassified') -----
testVariableAt
        self assert: (mirror variableAt: 2) == (array at: 2)!

----- Method: ObjectVmMirrorTest2>>testVariableAtPut (in category 'as yet unclassified') -----
testVariableAtPut
        | tmp |
        tmp := Object new.
        mirror variableAt: 2 put: tmp.
        self assert: (array at: 2) == tmp!

----- Method: ObjectVmMirrorTest2>>testVariableSize (in category 'as yet unclassified') -----
testVariableSize
        self assert: mirror variableSize = 3.!

TestCase subclass: #VariableSlotMirrorTest
        instanceVariableNames: 'mirror array'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Tests'!

----- Method: VariableSlotMirrorTest>>setUp (in category 'running') -----
setUp
       
        array := {#one. #two. #three}.
        mirror := VariableSlotMirror on: array index: 2.!

----- Method: VariableSlotMirrorTest>>testName (in category 'tests') -----
testName
        self assert: mirror name = '2'!

----- Method: VariableSlotMirrorTest>>testReflects (in category 'tests') -----
testReflects
        self assert: (mirror reflects: array)!

----- Method: VariableSlotMirrorTest>>testValue (in category 'tests') -----
testValue
        | actual expected |
        expected := array at: 2.
        actual := mirror value.
        self assert: actual == expected!

----- Method: VariableSlotMirrorTest>>testWrite (in category 'tests') -----
testWrite
        | tmp |
        tmp := Object new.
        mirror value: tmp.
        self assert: (array at: 2) == tmp!

Object subclass: #FixedSlotMirror
        instanceVariableNames: 'vmMirror index name'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Object'!

----- Method: FixedSlotMirror class>>on:index: (in category 'as yet unclassified') -----
on: anObject index: anInteger
        ^ self onVmMirror: (ObjectVmMirror on: anObject) index: anInteger!

----- Method: FixedSlotMirror class>>onVmMirror:index: (in category 'as yet unclassified') -----
onVmMirror: aMirror index: anInteger
        ^ self basicNew initializeWithMirror: aMirror index: anInteger!

----- Method: FixedSlotMirror>>initializeWithMirror:index: (in category 'as yet unclassified') -----
initializeWithMirror: aVmMirror index: anInteger
        | object |
       
        self initialize.
        vmMirror := aVmMirror.
        index := anInteger.
       
        "This should be done using a ClassMirror, once they're implemented."
        object := Reflection receiver: aVmMirror perform: #fixedAt: arguments: {1}.
        name := object class allInstVarNames at: anInteger!

----- Method: FixedSlotMirror>>name (in category 'as yet unclassified') -----
name
        ^ name!

----- Method: FixedSlotMirror>>value (in category 'as yet unclassified') -----
value
        ^ vmMirror fixedAt: index!

----- Method: FixedSlotMirror>>value: (in category 'as yet unclassified') -----
value: anObject
        vmMirror fixedAt: index put: anObject!

----- Method: FixedSlotMirror>>valueMirror (in category 'as yet unclassified') -----
valueMirror
        ^ ObjectMirror on: self value!

Object subclass: #MirrorInspector
        instanceVariableNames: 'mirror index'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Utilities'!

----- Method: MirrorInspector class>>inspect: (in category 'as yet unclassified') -----
inspect: anObject
        (self on: anObject) open!

----- Method: MirrorInspector class>>on: (in category 'as yet unclassified') -----
on: anObject
        | mirror |
        mirror := ObjectMirror on: anObject.
        ^ self basicNew initializeWithMirror: mirror!

----- Method: MirrorInspector>>buildWith: (in category 'building') -----
buildWith: aBuilder
        | list text window |
        list := aBuilder pluggableListSpec new
                model: self;
                frame: (LayoutFrame fractions: (0@0 corner: 0.5@1));
                list: #slotLabels;
                listSize: #slotCount;
                getIndex: #selectedSlotIndex;
                setIndex: #selectedSlotIndex:;
                doubleClick: #spawn;
                yourself.
        text := aBuilder pluggableTextSpec new
                model: self;
                frame: (LayoutFrame fractions: (0.5@0 corner: 1@1));
                askBeforeDiscardingEdits: false;
                getText: #slotPrintString;
                yourself.
        window := aBuilder pluggableWindowSpec new
                model: self;
                label: #label;
                extent: 300@200;
                children: {list. text}.
        ^ aBuilder build: window
                !

----- Method: MirrorInspector>>initializeWithMirror: (in category 'initialization') -----
initializeWithMirror: aMirror
        self initialize.
        mirror := aMirror.
        index := 0.!

----- Method: MirrorInspector>>label (in category 'callbacks') -----
label
        ^ 'Mirror Inspector on: ', self safePrintString!

----- Method: MirrorInspector>>open (in category 'initialization') -----
open
        ToolBuilder default open: self
        !

----- Method: MirrorInspector>>safePrintString (in category 'callbacks') -----
safePrintString
        ^ mirror safePrintString!

----- Method: MirrorInspector>>selectedSlotIndex (in category 'callbacks') -----
selectedSlotIndex
        ^ index !

----- Method: MirrorInspector>>selectedSlotIndex: (in category 'callbacks') -----
selectedSlotIndex: anInteger
        index := anInteger.
        self changed: #selectedSlotIndex.
        self changed: #slotPrintString!

----- Method: MirrorInspector>>slotCount (in category 'callbacks') -----
slotCount
        ^ mirror size!

----- Method: MirrorInspector>>slotLabels (in category 'callbacks') -----
slotLabels
        ^ mirror slots collect: [:ea | ea name]!

----- Method: MirrorInspector>>slotPrintString (in category 'callbacks') -----
slotPrintString
        ^ index = 0 ifFalse: [(mirror slotAt: index) valueMirror safePrintString]!

----- Method: MirrorInspector>>spawn (in category 'callbacks') -----
spawn
        index = 0 ifFalse: [self class inspect: (mirror slotAt: index) value]!

Object subclass: #ObjectMirror
        instanceVariableNames: 'vmMirror'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Object'!

----- Method: ObjectMirror class>>on: (in category 'as yet unclassified') -----
on: anObject
        ^ self basicNew initializeWithObject: anObject!

----- Method: ObjectMirror>>initializeWithObject: (in category 'initialization') -----
initializeWithObject: anObject
        self initialize.
        vmMirror := ObjectVmMirror on: anObject!

----- Method: ObjectMirror>>perform:arguments: (in category 'messages') -----
perform: aSelector arguments: anArray
        ^ vmMirror perform: aSelector arguments: anArray!

----- Method: ObjectMirror>>reflects: (in category 'messages') -----
reflects: anObject
        ^ vmMirror reflects: anObject!

----- Method: ObjectMirror>>safePrintString (in category 'printing') -----
safePrintString
        ^ vmMirror safePrintString!

----- Method: ObjectMirror>>size (in category 'slots') -----
size
        ^ vmMirror fixedSize + vmMirror variableSize!

----- Method: ObjectMirror>>slotAt: (in category 'slots') -----
slotAt: anInteger
        ^ self
                slotAt: anInteger
                ifAbsent: [self error: 'Slot doesn''t exist']!

----- Method: ObjectMirror>>slotAt:ifAbsent: (in category 'slots') -----
slotAt: anInteger ifAbsent: aBlock
        ^ self
                slotAt: anInteger
                ifPresent: [:val | val]
                ifAbsent: aBlock!

----- Method: ObjectMirror>>slotAt:ifPresent: (in category 'slots') -----
slotAt: anInteger ifPresent: aBlock
        ^ self
                slotAt: anInteger
                ifPresent: aBlock
                ifAbsent: [nil]!

----- Method: ObjectMirror>>slotAt:ifPresent:ifAbsent: (in category 'slots') -----
slotAt: anInteger ifPresent: pBlock ifAbsent: aBlock
        ^ anInteger <= self size
                ifTrue:
                        [| fixedSize slot |
                        fixedSize := vmMirror fixedSize.
                        slot := anInteger <= fixedSize
                                ifTrue: [FixedSlotMirror onVmMirror: vmMirror index: anInteger]
                                ifFalse: [VariableSlotMirror onVmMirror: vmMirror index: anInteger - fixedSize].
                        pBlock value: slot]
                ifFalse: aBlock
                                       

!

----- Method: ObjectMirror>>slots (in category 'slots') -----
slots
        ^ (1 to: self size) collect: [:i | self slotAt: i]!

----- Method: ObjectMirror>>understands: (in category 'messages') -----
understands: aSelector
        ^ vmMirror understands: aSelector!

Object subclass: #ObjectVmMirror
        instanceVariableNames: 'object'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Object'!

----- Method: ObjectVmMirror class>>on: (in category 'as yet unclassified') -----
on: anObject
        | inst |
        inst := self basicNew.
        inst initialize.
        Reflection
                receiver: inst
                perform: #fixedAt:put:
                arguments: {1. anObject}.
        ^ inst!

----- Method: ObjectVmMirror>>fixedAt: (in category 'slots') -----
fixedAt: anInteger
        ^ Reflection
                receiver: object
                perform: #fixedAt:
                arguments: {anInteger}!

----- Method: ObjectVmMirror>>fixedAt:put: (in category 'slots') -----
fixedAt: anInteger put: anObject
        ^ Reflection
                receiver: object
                perform: #fixedAt:put:
                arguments: {anInteger. anObject}!

----- Method: ObjectVmMirror>>fixedSize (in category 'slots') -----
fixedSize
        ^ Reflection
                receiver: object
                perform: #fixedSize
                arguments: #()!

----- Method: ObjectVmMirror>>perform:arguments: (in category 'messages') -----
perform: aSelector arguments: anArray
        ^ Reflection
                receiver: object
                perform: #perform:arguments:
                arguments: {aSelector. anArray}!

----- Method: ObjectVmMirror>>reflects: (in category 'testing') -----
reflects: anObject
        ^ anObject == object!

----- Method: ObjectVmMirror>>safeIdentityHash (in category 'printing') -----
safeIdentityHash
        ^ Reflection
                receiver: object
                perform: #identityHash
                arguments: #()!

----- Method: ObjectVmMirror>>safePrintOn: (in category 'printing') -----
safePrintOn: aStream
        aStream
                nextPutAll: object class name;
                nextPut: $[;
                print: self safeIdentityHash;
                nextPut: $]!

----- Method: ObjectVmMirror>>safePrintString (in category 'printing') -----
safePrintString
        ^ String streamContents: [:stream | self safePrintOn: stream]!

----- Method: ObjectVmMirror>>understands: (in category 'messages') -----
understands: aSelector
        "This should use a ClassMirror, but that isn't implemented yet. For now, #class is
        fine, because it's implemented as a byte code and doesn't send a messages to
        the reflectee"

        ^ object class canUnderstand: aSelector!

----- Method: ObjectVmMirror>>variableAt: (in category 'slots') -----
variableAt: anInteger
        ^ Reflection
                receiver: object
                perform: #variableAt:
                arguments: {anInteger}!

----- Method: ObjectVmMirror>>variableAt:put: (in category 'slots') -----
variableAt: anInteger put: anObject
        ^ Reflection
                receiver: object
                perform: #variableAt:put:
                arguments: {anInteger. anObject}!

----- Method: ObjectVmMirror>>variableSize (in category 'slots') -----
variableSize
        ^ Reflection
                receiver: object
                perform: #variableSize
                arguments: #()!

Object subclass: #Reflection
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Utilities'!

----- Method: Reflection class>>basicNew (in category 'as yet unclassified') -----
basicNew
        self error: 'Reflection should never be instanciated'!

----- Method: Reflection class>>primitiveFailedFor: (in category 'as yet unclassified') -----
primitiveFailedFor: anObject
        "Can make this smarter"
       
        self error: 'primitive failed'!

----- Method: Reflection class>>receiver:perform:arguments: (in category 'as yet unclassified') -----
receiver: anObject perform: aSelector arguments: anArray
        | cm |
        cm := self compiledMethodAt: aSelector ifAbsent:
                [^ anObject doesNotUnderstand: (Message selector: aSelector arguments: anArray)].
        ^ self receiver: anObject withArguments: anArray executeMethod: cm!

----- Method: Reflection class>>receiver:withArguments:executeMethod: (in category 'as yet unclassified') -----
receiver: receiver withArguments: argArray executeMethod: compiledMethod
        <primitive: 188>
        self primitiveFailed!

----- Method: Reflection class>>with:do: (in category 'as yet unclassified') -----
with: anObject do: aBlock
        | result shunt |
        shunt := MessageShunt handler:
                [:message || cm |
                cm := self compiledMethodAt: message selector.
                result := self
                        receiver: anObject
                        withArguments: message arguments
                        executeMethod: cm].
        aBlock value: shunt.
        ^ result
                !

----- Method: Reflection>>fixedAt: (in category 'as yet unclassified') -----
fixedAt: anInteger
        <primitive: 73>
        ^ Reflection primitiveFailedFor: self!

----- Method: Reflection>>fixedAt:put: (in category 'as yet unclassified') -----
fixedAt: anInteger put: anObject
        <primitive: 74>
        ^ Reflection primitiveFailedFor: self!

----- Method: Reflection>>fixedSize (in category 'as yet unclassified') -----
fixedSize
        "We can get away with sending #class here because the compiler emits
        a bytecode that reads the class pointer directly."
       
        | format |
        0 flag: #instSizeChange.
        format := Reflection receiver: self class perform: #fixedAt: arguments: {3}.
        ^ ((format bitShift: -10) bitAnd: 16rC0) + ((format bitShift: -1) bitAnd: 16r3F) - 1.
       
        !

----- Method: Reflection>>identityHash (in category 'as yet unclassified') -----
identityHash
        <primitive: 75>
        self class == SmallInteger ifTrue: [^ self].
        Reflection primitiveFailedFor: self!

----- Method: Reflection>>perform:arguments: (in category 'as yet unclassified') -----
perform: aSelector arguments: anArray
        <primitive: 84>
        Reflection primitiveFailedFor: self!

----- Method: Reflection>>variableAt: (in category 'as yet unclassified') -----
variableAt: anInteger
        <primitive: 60>
        ^ Reflection primitiveFailedFor: self!

----- Method: Reflection>>variableAt:put: (in category 'as yet unclassified') -----
variableAt: anInteger put: anObject
        <primitive: 61>
        Reflection primitiveFailedFor: self!

----- Method: Reflection>>variableSize (in category 'as yet unclassified') -----
variableSize
        <primitive: 62>
        ^ 0!

Object subclass: #VariableSlotMirror
        instanceVariableNames: 'vmMirror index'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Mirrors-Object'!

----- Method: VariableSlotMirror class>>on:index: (in category 'as yet unclassified') -----
on: anObject index: anInteger
        ^ self onVmMirror: (ObjectVmMirror on: anObject) index: anInteger!

----- Method: VariableSlotMirror class>>onVmMirror:index: (in category 'as yet unclassified') -----
onVmMirror: aMirror index: anInteger
        ^ self basicNew initializeWithMirror: aMirror index: anInteger!

----- Method: VariableSlotMirror>>initializeWithMirror:index: (in category 'as yet unclassified') -----
initializeWithMirror: aVmMirror index: anInteger
        self initialize.
        vmMirror := aVmMirror.
        index := anInteger!

----- Method: VariableSlotMirror>>name (in category 'as yet unclassified') -----
name
        ^ index asString!

----- Method: VariableSlotMirror>>reflects: (in category 'as yet unclassified') -----
reflects: anObject
        ^ vmMirror reflects: anObject!

----- Method: VariableSlotMirror>>value (in category 'as yet unclassified') -----
value
        ^ vmMirror variableAt: index!

----- Method: VariableSlotMirror>>value: (in category 'as yet unclassified') -----
value: anObject
        ^ vmMirror variableAt: index put: anObject!

----- Method: VariableSlotMirror>>valueMirror (in category 'as yet unclassified') -----
valueMirror
        ^ ObjectMirror on: self value!