VM Maker: VMMakerCompatibilityForPharo6-eem.1.mcz

 
Eliot Miranda uploaded a new version of VMMakerCompatibilityForPharo6 to project VM Maker:
http://source.squeak.org/VMMaker/VMMakerCompatibilityForPharo6-eem.1.mcz

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

Name: VMMakerCompatibilityForPharo6-eem.1
Author: eem
Time: 13 August 2018, 4:11:01.718248 pm
UUID: f1ffa3f1-ba2f-0d00-8b88-25d10cb2214f
Ancestors:

Compatibility methods and classes for VMMaker when loaded into Pharo6.  Right now gets around EndianDetector and the lack of MethodReference.

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

SystemOrganization addCategory: #VMMakerCompatibilityForPharo6!
SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-System'!

----- Method: SmalltalkImage>>endianness (in category '*VMMakerCompatibilityForPharo6-accessing') -----
endianness
        "Pluralitas non est ponenda sine necessitate..."
        ^EndianDetector endianness!

Object subclass: #MethodReference
        instanceVariableNames: 'classSymbol classIsMeta methodSymbol stringVersion category environment'
        classVariableNames: 'InvalidReference'
        poolDictionaries: ''
        category: 'VMMakerCompatibilityForPharo6-System'!

!MethodReference commentStamp: 'eem 8/13/2018 15:59' prior: 0!
A MethodReference is is a lightweight proxy for a CompiledMethod.  Has methods for pointed to the CompileMethod's source statements, byte codes. Is heavily used by Tools.

Instance Variables
        classIsMeta:     Boolean class vs. instance
        classSymbol: Symbol for method's class (without class keyword if meta)
        methodSymbol: Symbol for method's selector
        stringVersion: 'Class>>selector:' format!

----- Method: MethodReference class>>class:selector: (in category 'instance creation') -----
class: aClass selector: aSelector
        ^ self class: aClass selector: aSelector environment: aClass environment.!

----- Method: MethodReference class>>class:selector:environment: (in category 'instance creation') -----
class: aClass selector: aSelector environment: anEnvironment
        ^ self new setStandardClass: aClass methodSymbol: aSelector environment: anEnvironment.!

----- Method: MethodReference class>>cleanUp: (in category 'class initialization') -----
cleanUp: aggressive

        aggressive ifTrue: [InvalidReference := nil].!

----- Method: MethodReference class>>invalid (in category 'instance creation') -----
invalid
        "Creates an invalid method reference to avoid the usage of nil."
       
        ^ InvalidReference ifNil: [
                InvalidReference := self new
                        setClassSymbol: #NonExistentClass
                        classIsMeta: false
                        methodSymbol: #nonExistentSelector
                        stringVersion: '<The Invalid Method Reference>']!

----- Method: MethodReference>><= (in category 'comparing') -----
<= anotherMethodReference

        classSymbol < anotherMethodReference classSymbol ifTrue: [^true].
        classSymbol > anotherMethodReference classSymbol ifTrue: [^false].
        classIsMeta = anotherMethodReference classIsMeta ifFalse: [^classIsMeta not].
        ^methodSymbol <= anotherMethodReference methodSymbol!

----- Method: MethodReference>>= (in category 'comparing') -----
= anotherMethodReference
        "Answer whether the receiver and the argument represent the
        same object."
        ^ self species == anotherMethodReference species
                and: [self classSymbol = anotherMethodReference classSymbol
                and: [self classIsMeta = anotherMethodReference classIsMeta
                and: [self methodSymbol = anotherMethodReference methodSymbol
                and: [self environment == anotherMethodReference environment]]]]!

----- Method: MethodReference>>actualClass (in category 'accessing') -----
actualClass
        ^self environment at: classSymbol ifPresent: [ :actualClass |
                classIsMeta
                        ifTrue: [ actualClass classSide ]
                        ifFalse: [ actualClass ] ]!

----- Method: MethodReference>>asCodeReference (in category 'converting') -----
asCodeReference

        ^ self!

----- Method: MethodReference>>asString (in category 'converting') -----
asString

        ^(stringVersion ifNil: [ self stringVersionDefault ]) asString!

----- Method: MethodReference>>asStringOrText (in category 'converting') -----
asStringOrText

        ^stringVersion ifNil: [ self stringVersionDefault ]!

----- Method: MethodReference>>asValid (in category 'converting') -----
asValid
        "Sometimes persistent MethodReferences may become stale after a refactoring which moved some methods to a superclass.  This method answers the new valid MethodReference if that happened."
        ^ self isValid
                ifTrue: [ self ]
                ifFalse:
                        [ | cm |
                        cm := self actualClass lookupSelector: self selector.
                        cm ifNotNil: [ cm methodReference ] ]!

----- Method: MethodReference>>category (in category 'accessing') -----
category
        "Answers the class category (cached for reuse via MC and other tools)"
        ^ category ifNil: [category := self actualClass organization categoryOfElement: methodSymbol]!

----- Method: MethodReference>>category: (in category 'initialize-release') -----
category: aSymbol
        category := aSymbol!

----- Method: MethodReference>>classIsMeta (in category 'testing') -----
classIsMeta

        ^classIsMeta!

----- Method: MethodReference>>classSymbol (in category 'accessing') -----
classSymbol

        ^classSymbol!

----- Method: MethodReference>>compiledMethod (in category 'accessing') -----
compiledMethod
        ^self actualClass compiledMethodAt: methodSymbol ifAbsent: nil!

----- Method: MethodReference>>environment (in category 'accessing') -----
environment
        ^ environment ifNil: [
                "We will probably have MethodReferences already instantiated when this commit lands. We lazily move these over to the new, Environment aware, order of things."
                environment := Smalltalk globals].!

----- Method: MethodReference>>hash (in category 'comparing') -----
hash
        "Answer a SmallInteger whose value is related to the receiver's  
        identity."
        ^ (self species hash bitXor: self classSymbol hash)
                bitXor: self methodSymbol hash!

----- Method: MethodReference>>isClassReference (in category 'testing') -----
isClassReference

        ^ false!

----- Method: MethodReference>>isMethodReference (in category 'testing') -----
isMethodReference

        ^ true!

----- Method: MethodReference>>isValid (in category 'testing') -----
isValid
        "Answer whether the receiver represents a current selector or Comment"

        | aClass |
        methodSymbol isDoIt ifTrue: [^ false].
        (aClass := self actualClass) ifNil: [^ false].
        ^ (aClass includesSelector: methodSymbol) or:
                [methodSymbol == #Comment]!

----- Method: MethodReference>>methodSymbol (in category 'accessing') -----
methodSymbol

        ^methodSymbol!

----- Method: MethodReference>>printOn: (in category 'printing') -----
printOn: aStream
        | actualClass |
        "Print the receiver on a stream"
        actualClass := classSymbol asString.
        classIsMeta ifTrue: [actualClass := actualClass, ' class'].
        super printOn: aStream.
        aStream nextPutAll: ' ', actualClass, ' >> ', methodSymbol printString.!

----- Method: MethodReference>>selector (in category 'accessing') -----
selector

        ^methodSymbol!

----- Method: MethodReference>>setClass:methodSymbol:stringVersion: (in category 'initialize-release') -----
setClass: aClass methodSymbol: methodSym stringVersion: aString

        classSymbol := aClass theNonMetaClass name.
        classIsMeta := aClass isMeta.
        methodSymbol := methodSym.
        environment := aClass environment.
        stringVersion := aString.!

----- Method: MethodReference>>setClassAndSelectorIn: (in category 'initialize-release') -----
setClassAndSelectorIn: csBlock

        ^csBlock value: self actualClass value: methodSymbol!

----- Method: MethodReference>>setClassSymbol:classIsMeta:methodSymbol:stringVersion: (in category 'initialize-release') -----
setClassSymbol: classSym classIsMeta: isMeta methodSymbol: methodSym stringVersion: aString

        classSymbol := classSym.
        classIsMeta := isMeta.
        methodSymbol := methodSym.
        stringVersion := aString.!

----- Method: MethodReference>>setStandardClass:methodSymbol: (in category 'initialize-release') -----
setStandardClass: aClass methodSymbol: methodSym

        classSymbol := aClass theNonMetaClass name.
        environment := aClass environment.
        classIsMeta := aClass isMeta.
        methodSymbol := methodSym.
        stringVersion := nil.!

----- Method: MethodReference>>setStandardClass:methodSymbol:environment: (in category 'initialize-release') -----
setStandardClass: aClass methodSymbol: aSelector environment: anEnvironment
        classSymbol := aClass theNonMetaClass name.
        classIsMeta := aClass isMeta.
        methodSymbol := aSelector.
        environment := anEnvironment.
        stringVersion := nil.!

----- Method: MethodReference>>source (in category 'accessing') -----
source
        ^ (self actualClass sourceCodeAt: methodSymbol) asString withSqueakLineEndings!

----- Method: MethodReference>>sourceCode (in category 'accessing') -----
sourceCode

        ^ self actualClass sourceCodeAt: self methodSymbol!

----- Method: MethodReference>>sourceString (in category 'accessing') -----
sourceString

        ^ self sourceCode asString!

----- Method: MethodReference>>stringVersion (in category 'accessing') -----
stringVersion

        ^stringVersion ifNil: [self asStringOrText]!

----- Method: MethodReference>>stringVersion: (in category 'accessing') -----
stringVersion: aString

        stringVersion := aString!

----- Method: MethodReference>>stringVersionDefault (in category 'accessing') -----
stringVersionDefault

        ^classSymbol, (classIsMeta ifTrue: [ ' class ' ] ifFalse: [' ']), methodSymbol  !

----- Method: MethodReference>>timeStamp (in category 'accessing') -----
timeStamp
        ^ self compiledMethod timeStamp!