VM Maker: CogAttic-eem.1.mcz

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

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

Name: CogAttic-eem.1
Author: eem
Time: 3 April 2017, 9:33:17.758106 am
UUID: 51c2ce88-51e0-4384-b3e2-865d53d2cfd8
Ancestors:

Move a bunch of obsolete code to a history-preservation package to lessen Undeclared pollution of Cog.

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

SystemOrganization addCategory: #'CogAttic-Scripts'!
SystemOrganization addCategory: #'CogAttic-Bootstrapping'!

Object subclass: #SpurBootstrapMonticelloPackagePatcher
        instanceVariableNames: 'sourceDir destDir packagesAndPatches imageTypes'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Bootstrapping'!

!SpurBootstrapMonticelloPackagePatcher commentStamp: 'eem 1/15/2014 17:59' prior: 0!
A SpurBootstrapMonticelloPackagePatcher is used to construct a new set of patched Monticello packages for Spur.  The use case is some bootstrap process loads a set of Monticello packages.  To repeat the bootstrap with a Spur image the bootstrap must use suitably patched Monticello packages containing the new method versions on the class side of SpurBootstrap.

Instance Variables
        destDir: <FileDirectory>
        sourceDir: <FileDirectory>

destDir
        - directory to which patched packages are to be written

sourceDir
        - directory from which packages to be patched are to be read!

----- Method: SpurBootstrapMonticelloPackagePatcher class>>squeak45baseline (in category 'baselines') -----
squeak45baseline
        "The base Squeak-4.5-13680 package set."
        ^#( name 'base-Squeak45-eem'
                repository ('http://source.squeak.org/squeak45')
                dependency ('Squeak-Version' 'Squeak-Version-ar.4662' '6bfece28-65a4-b147-9462-417b2e86acd0')
                dependency ('311Deprecated' '311Deprecated-nice.2' '6df45c33-740a-fc4f-b3d0-45412ad7d284')
                dependency ('39Deprecated' '39Deprecated-ar.19' '8da20c38-7d28-3241-9f29-da261d6f9bfe')
                dependency ('45Deprecated' '45Deprecated-fbs.24' '4033c169-94c6-7741-9aee-5a7570a7ec7a')
                dependency ('Balloon' 'Balloon-nice.24' '97e2ed51-707d-4da1-ab4f-35add3deee5e')
                dependency ('Network' 'Network-nice.150' 'c844e5ea-c919-44fc-905e-69487b035947')
                dependency ('Compression' 'Compression-fbs.40' '82b0d6e4-0239-1241-968c-461a785fb6a7')
                dependency ('Graphics' 'Graphics-nice.289' 'e809bcbf-53e1-420b-846a-9e86e0dd1f06')
                dependency ('Multilingual' 'Multilingual-fbs.194' '07f4a7b5-7169-3345-85fc-5a8ba04e5323')
                dependency ('CollectionsTests' 'CollectionsTests-dtl.214' 'cf157d3a-2d71-46f3-86ce-450ee24e8d27')
                dependency ('PackageInfo-Base' 'PackageInfo-Base-nice.68' 'b6669527-9a35-4783-a64f-8f2af97e330b')
                dependency ('Compiler' 'Compiler-nice.279' '94b1b5f8-f71b-4425-b035-461d3dc94e3f')
                dependency ('Environments' 'Environments-ul.46' 'cfd9e7f7-6a4b-400e-b9c7-9c6239da4752')
                dependency ('Kernel' 'Kernel-dtl.836' '410e695f-7f23-43e4-9dc2-d292b9954f0d')
                dependency ('MonticelloConfigurations' 'MonticelloConfigurations-fbs.123' 'b9735d10-7cf4-a746-8a64-b50fa9cf273f')
                dependency ('Tools' 'Tools-cmm.519' 'dae6bdb9-8b54-491a-a2a4-0b114f02e10d')
                dependency ('MorphicExtras' 'MorphicExtras-tpr.147' 'e76a71a5-6be9-4420-b71a-2c92d900c476')
                dependency ('Files' 'Files-dtl.130' '8ee82071-69f7-446d-8ed7-77eafc838f03')
                dependency ('System' 'System-dtl.666' '098b856a-ecc5-498a-bceb-ef3457d3511e')
                dependency ('Collections' 'Collections-ul.564' '4b9a37ef-df86-40a0-a0dd-8e8b2c04d4ed')
                dependency ('Monticello' 'Monticello-cmm.586' 'a4dbd656-e50a-47ba-8661-44f8c87bb3e0')
                dependency ('EToys' 'EToys-cmm.117' 'c3e71dbe-17af-4b71-ad9c-c0bb2a2bc193')
                dependency ('Exceptions' 'Exceptions-cmm.49' '6cede9fe-b13d-481a-b8de-bb004ece1145')
                dependency ('FlexibleVocabularies' 'FlexibleVocabularies-bf.13' '55c72a72-619e-4a81-831f-303600bbd792')
                dependency ('GraphicsTests' 'GraphicsTests-fbs.38' '081189cc-a44f-fa4e-965e-25438280ea93')
                dependency ('Installer-Core' 'Installer-Core-cmm.392' '7cb5c040-6f68-479d-bc9e-0b264b172443')
                dependency ('KernelTests' 'KernelTests-nice.259' '0f7301b0-612c-49d8-936f-775995b35e0f')
                dependency ('GetText' 'GetText-nice.34' '4d432f8e-55be-428a-9138-63dd1738035e')
                dependency ('Sound' 'Sound-nice.38' 'b626daf0-be23-4fb8-b2d5-04b9cd370539')
                dependency ('ToolBuilder-Tests' 'ToolBuilder-Tests-cmm.1' 'e77685b9-ca09-40c0-b84e-6caee75f4075')
                dependency ('Morphic' 'Morphic-cmm.720' 'e5e81c18-990b-4e35-b325-adb032b8418d')
                dependency ('MorphicTests' 'MorphicTests-nice.24' 'e33a9ad3-2f39-4c19-a3a7-dc87f18177fc')
                dependency ('MorphicExtrasTests' 'MorphicExtrasTests-fbs.3' '1c039763-bc92-834c-943e-d96d8820cbd7')
                dependency ('MultilingualTests' 'MultilingualTests-fbs.18' '07e26018-8455-3349-9b44-9ecb4aaeefb2')
                dependency ('Nebraska' 'Nebraska-nice.36' 'cc80dca4-ed72-4c39-952c-3b37886100de')
                dependency ('NetworkTests' 'NetworkTests-fbs.37' '97699685-5826-fe47-af98-356971abf2fb')
                dependency ('PreferenceBrowser' 'PreferenceBrowser-fbs.49' '72d30dfa-0ff5-4347-9823-eb77ae236f8f')
                dependency ('Protocols' 'Protocols-nice.46' '15b63671-d541-4c1d-9ff5-72da4fc5bfe9')
                dependency ('SMBase' 'SMBase-nice.132' 'a70c8bd2-3eee-4e21-b9c6-113f6b194527')
                dependency ('SMLoader' 'SMLoader-fbs.79' '9f7d983e-d958-4115-94aa-21302f89ad8b')
                dependency ('ST80' 'ST80-cmm.172' '47b2f84a-6951-480b-88f2-b2726dba08bd')
                dependency ('ST80Tests' 'ST80Tests-nice.2' '7ee5426b-73f1-48ac-8ec4-3943dc452cb6')
                dependency ('ST80Tools' 'ST80Tools-fbs.1' '108ec7bc-d1f5-dd4b-9511-e7a653a71e9f')
                dependency ('SUnit' 'SUnit-fbs.99' 'a5be81dd-6e9f-8d41-a091-3c6c27a28abe')
                dependency ('SUnitGUI' 'SUnitGUI-fbs.59' '0bfcf308-0d02-a749-9930-6229492cca48')
                dependency ('ScriptLoader' 'ScriptLoader-cmm.338' 'adb79117-0915-40a5-a5ee-c766e4b50d42')
                dependency ('Services-Base' 'Services-Base-topa.51' '94328e86-1643-4090-8f18-bc4467119161')
                dependency ('SmallLand-ColorTheme' 'SmallLand-ColorTheme-fbs.6' 'a78b81e3-3b11-c24e-9c84-3bb5319e0858')
                dependency ('SystemChangeNotification-Tests' 'SystemChangeNotification-Tests-nice.23' '3eed6d26-4aef-4095-a604-d9f914240281')
                dependency ('Tests' 'Tests-cmm.290' 'f3fccfae-6baf-4093-ba62-e15ef110a687')
                dependency ('ToolBuilder-Kernel' 'ToolBuilder-Kernel-nice.60' '86949a07-725b-4a27-a7cd-a827c74f48be')
                dependency ('ToolBuilder-MVC' 'ToolBuilder-MVC-fbs.34' 'aded987d-5cd5-6f41-9635-1d38da947ddf')
                dependency ('ToolBuilder-Morphic' 'ToolBuilder-Morphic-fbs.91' 'abaa076b-af43-af42-8c98-7a71482c6a30')
                dependency ('ToolBuilder-SUnit' 'ToolBuilder-SUnit-fbs.19' '3e30756c-2af8-0741-836f-0d42a9d5af32')
                dependency ('ToolsTests' 'ToolsTests-cmm.68' '98c1608a-6cb3-4a03-a28a-dd101e6c876b')
                dependency ('MonticelloForTraits' 'MonticelloForTraits-fbs.1' '160be615-5ab7-4148-a7cb-60dd629ab085')
                dependency ('Traits' 'Traits-topa.302' '58712f55-3f3f-467e-ac0e-e118c9737c53')
                dependency ('TraitsTests' 'TraitsTests-fbs.13' '0429146f-6767-4a4f-8fce-37571625920a')
                dependency ('TrueType' 'TrueType-nice.28' '42a74f04-e193-455b-a2c1-14ec51724234')
                dependency ('Universes' 'Universes-nice.46' '805eb73f-391b-4e3f-aef9-64add79e4e8c')
                dependency ('VersionNumber' 'VersionNumber-cmm.4' '68fb1f05-d3e2-4c9b-9234-20a9bed166dc')
                dependency ('XML-Parser' 'XML-Parser-fbs.36' 'a2d9791a-c341-564b-9b57-a0fe9f42b66f')
                dependency ('ReleaseBuilder' 'ReleaseBuilder-cmm.114' 'ea773780-69e1-48dd-a16c-e167acb9de04')
                dependency ('ShoutCore' 'ShoutCore-cwp.40' '81b3e230-2e8a-42c5-9521-e54338fadb6f')
                dependency ('VersionNumberTests' 'VersionNumberTests-fbs.4' '953a944c-9648-dd4b-898e-9e10e0507b91')
                dependency ('HelpSystem-Core' 'HelpSystem-Core-ul.56' '6d8a0d54-5f60-da45-8c3c-d42ea8abd999')
                dependency ('HelpSystem-Tests' 'HelpSystem-Tests-fbs.15' '8927a848-29a0-f54c-8c79-efb8070c4702')
                dependency ('Help-Squeak-Project' 'Help-Squeak-Project-kfr.10' 'b86eb622-cc53-634d-aa65-aed2c86263f9')
                dependency ('Help-Squeak-TerseGuide' 'Help-Squeak-TerseGuide-dtl.2' '8b18cab9-7183-4c5e-8cac-f79c4400da43')
                dependency ('SystemReporter' 'SystemReporter-ul.21' '34c5c48c-e7cc-4dfe-8133-6dec3bc63ff7')
                dependency ('BalloonTests' 'BalloonTests-egp.2' 'a8206c39-12ee-4222-a29a-caa537e037c4')
                dependency ('CommandLine' 'CommandLine-fbs.2' '414e59b8-4f4a-814d-9dac-b7b9886e92a0')
                dependency ('UpdateStream' 'UpdateStream-nice.4' '5fcdedce-88aa-469a-bf8b-32820f051c4f')
                )!

----- Method: SpurBootstrapMonticelloPackagePatcher>>cachedNonDiffyVersionNamed:from: (in category 'patching') -----
cachedNonDiffyVersionNamed: versionName from: repo
        "Make sure that the cache contains a non-diffy version of versionName and  answer it."
        | cacheRepo nonDiffyVersion |
        self assert: (versionName endsWith: '.mcz').
        cacheRepo := MCCacheRepository default.
        "Make sure that at least the diffy (.mcd) version is present"
        (cacheRepo directory includesKey: versionName) ifFalse:
                [cacheRepo storeVersion: (repo versionNamed: versionName)].
        "if after storeVersion there's still no .mcz we need to create one; sigh..."
        (cacheRepo directory includesKey: versionName) ifFalse:
                [| baseName diffyVersionName diffyVersion file delete |
                 baseName := versionName allButLast: 4. "strip .mcz"
                 diffyVersionName := cacheRepo directory fileNames detect: [:fn| (fn endsWith: '.mcd') and: [(fn copyUpTo: $() = baseName]].
                 diffyVersion := cacheRepo versionNamed: diffyVersionName.
                 file := cacheRepo directory newFileNamed: versionName.
                 delete := false.
                 [file binary.
                  [MCMczWriter fileOut: diffyVersion on: file]
                        on: Error
                        do: [:ex|
                                delete := true. "don't leave half-formed .mcz files around to screw things up later on..."
                                ex pass]]
                        ensure:
                                [file close.
                                 delete ifTrue:
                                        [cacheRepo directory deleteFileNamed: versionName]].
                 "now delete the damn diffy version that caused all the pain in the first place"
                 delete ifFalse:
                        [cacheRepo directory deleteFileNamed: diffyVersionName].
                 cacheRepo flushCache; cacheAllFilenames].
        nonDiffyVersion := cacheRepo versionNamed: versionName.
        self assert: (nonDiffyVersion fileName endsWith: '.mcz').
        ^nonDiffyVersion!

----- Method: SpurBootstrapMonticelloPackagePatcher>>classDefinitionFor:type:from:comment:stamp: (in category 'private-accessing') -----
classDefinitionFor: className type: typeSymbol from: definitions comment: commentString stamp: stampString
        | classDef |
        classDef := definitions
                                        detect: [:d| d isClassDefinition and: [d className = className]]
                                        ifNone:
                                                [self assert: (#(BoxedFloat64 SmallFloat64) includes: className).
                                                 MCClassDefinition new
                                                        initializeWithName: className
                                                        superclassName: #Float
                                                        traitComposition: '{}'
                                                        classTraitComposition: '{}'
                                                        category: 'Kernel-Numbers'
                                                        instVarNames: #()
                                                        classVarNames: #()
                                                        poolDictionaryNames: #()
                                                        classInstVarNames: #()
                                                        type: typeSymbol
                                                        comment: commentString asString
                                                        commentStamp: stampString].
        className == #Character ifTrue:
                [classDef variables removeAllSuchThat:
                        [:varDef|
                         varDef isInstanceVariable and: [varDef name = 'value']]].
        classDef instVarNamed: 'type' put: typeSymbol.
        commentString ifNotNil:
                [classDef
                        instVarNamed: 'comment' put: commentString;
                        instVarNamed: 'commentStamp' put: stampString].
        ^MCAddition of: classDef!

----- Method: SpurBootstrapMonticelloPackagePatcher>>compiledMethodClassDefinition (in category 'private-accessing') -----
compiledMethodClassDefinition
        ^MCAddition of:
                (MCClassDefinition new
                        initializeWithName: #CompiledMethod
                        superclassName: #ByteArray
                        category: #'Kernel-Methods'
                        instVarNames: #()
                        classVarNames: #(LargeFrame PrimaryBytecodeSetEncoderClass SecondaryBytecodeSetEncoderClass SmallFrame)
                        poolDictionaryNames: #()
                        classInstVarNames: #()
                        type: #compiledMethod
                        comment:
'CompiledMethod instances are methods suitable for interpretation by the virtual machine.  Instances of CompiledMethod and its subclasses are the only objects in the system that have both indexable pointer fields and indexable 8-bit integer fields.  The first part of a CompiledMethod is pointers, the second part is bytes.  CompiledMethod inherits from ByteArray to avoid duplicating some of ByteArray''s methods, not because a CompiledMethod is-a ByteArray.

Class variables:
SmallFrame - the number of stack slots in a small frame Context
LargeFrame - the number of stack slots in a large frame Context
PrimaryBytecodeSetEncoderClass - the encoder class that defines the primary instruction set
SecondaryBytecodeSetEncoderClass - the encoder class that defines the secondary instruction set

The current format of a CompiledMethod is as follows:

        header (4 or 8 bytes, SmallInteger)
        literals (4 or 8 bytes each, Object, see "The last literal..." below)
        bytecodes  (variable, bytes)
        trailer (variable, bytes)

The header is a SmallInteger (which in the 32-bit system has 31 bits, and in the 64-bit system, 61 bits) in the following format:

        (index 0) 15 bits: number of literals (#numLiterals)
        (index 15)  1 bit: is optimized - reserved for methods that have been optimized by Sista
        (index 16)  1 bit: has primitive
        (index 17)  1 bit: whether a large frame size is needed (#frameSize => either SmallFrame or LargeFrame)
        (index 18)  6 bits: number of temporary variables (#numTemps)
        (index 24)  4 bits: number of arguments to the method (#numArgs)
        (index 28)  2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public), although accessors for bit 29 exist (see #flag).
        sign bit:  1 bit: selects the instruction set, >= 0 Primary, < 0 Secondary (#signFlag)

If the method has a primitive then the first bytecode of the method must be a callPrimitive: bytecode that encodes the primitive index.

The trailer is an encoding of an instance of CompiledMethodTrailer.  It is typically used to encode the index into the source files array of the method''s source, but may be used to encode other values, e.g. tempNames, source as a string, etc.  See the class CompiledMethodTrailer.

The last literal in a CompiledMethod must be its methodClassAssociation, a binding whose value is the class the method is installed in.  The methodClassAssociation is used to implement super sends.  If a method contains no super send then its methodClassAssociation may be nil (as would be the case for example of methods providing a pool of inst var accessors).  By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState.  AdditionalMethodState holds any pragmas and properties of a method, but may also be used to add instance variables to a method, albeit ones held in the method''s AdditionalMethodState.  Subclasses of CompiledMethod that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledMethod subclass to answer the specialized subclass of AdditionalMethodState.'
                        commentStamp: 'eem 1/22/2015 15:47')!

----- Method: SpurBootstrapMonticelloPackagePatcher>>directoryFrom: (in category 'initialization') -----
directoryFrom: dirName
        ^FileDirectory on: (dirName first = $/
                                                        ifTrue: [dirName]
                                                        ifFalse: [(FileDirectory default directoryNamed: dirName) fullName])!

----- Method: SpurBootstrapMonticelloPackagePatcher>>download:from: (in category 'repository population') -----
download: baseConfigurationOrArray "<MCConfiguration|Array>" from: repo
        | base |
        base := baseConfigurationOrArray isArray
                                ifTrue: [MCConfiguration fromArray: baseConfigurationOrArray]
                                ifFalse: [baseConfigurationOrArray].
        self packagesAndPatches keysAndValuesDo:
                [:package :patches| | dependency |
                dependency := base dependencies detect: [:dep| dep package name = package name].
                self downloadToSourceDirAllPackageVersionsStartingWith: dependency versionInfo
                        from: repo].!

----- Method: SpurBootstrapMonticelloPackagePatcher>>downloadToSourceDirAllPackageVersionsStartingWith:from: (in category 'repository population') -----
downloadToSourceDirAllPackageVersionsStartingWith: aMCVersionInfo from: repo
        | localRepo priorName |
        priorName := MCVersionName on: (aMCVersionInfo versionName
                                                                                        copyReplaceAll: aMCVersionInfo versionNumber asString
                                                                                        with: (aMCVersionInfo versionNumber - 1) asString).
        localRepo := MCDirectoryRepository directory: sourceDir.
        (repo possiblyNewerVersionsOfAnyOf: {priorName asMCVersionName}) do:
                [:newerVersion |
                (localRepo includesVersionNamed: newerVersion) ifFalse:
                        [localRepo storeVersion: (repo versionNamed: newerVersion)]]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>filesForPackage:in: (in category 'private-accessing') -----
filesForPackage: package in: aDirectory
        "Names sorted from lowest version to highest"
        ^((aDirectory fileNames
                        select:
                                [:fileName|
                                (fileName beginsWith: package name)
                                 and: [(fileName at: package name size + 1) isLetter not
                                 and: [(fileName copyFrom: package name size + 2 to: package name size + 5) ~= 'spur']]]
                        thenCollect: [:fn| {fn asMCVersionName versionNumber. fn}])
                sort: [:tuple :tupolev|
                        tuple first < tupolev first
                        or: [tuple first = tupolev first
                                and: [tuple last < tupolev last]]])
                collect: [:tuple| tuple last]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>filteredDefinitionsAsPatches:patches: (in category 'private-accessing') -----
filteredDefinitionsAsPatches: modifiedDefinitions patches: existingPatches
        ^modifiedDefinitions
                select:
                        [:def|
                         existingPatches noneSatisfy:
                                [:addition|
                                def isMethodDefinition
                                and: [addition definition isMethodDefinition
                                and: [addition definition selector = def selector
                                and: [addition definition className = def className
                                and: [addition definition classIsMeta = def classIsMeta]]]]]]
                thenCollect:
                        [:def|
                         ((def source includesSubString: 'DELETEME')
                                ifTrue: [MCRemoval]
                                ifFalse: [MCAddition]) of: def]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>findOldestConfigurationFor:inVersionNames:repository: (in category 'configurations') -----
findOldestConfigurationFor: packageVersions inVersionNames: configurationVersionNames repository: repo
        | oldest |
        oldest := configurationVersionNames first.
        configurationVersionNames do:
                [:cfgver| | config |
                config := repo versionNamed: cfgver.
                (packageVersions noneSatisfy:
                        [:pkgver| | configVersion |
                        configVersion := config dependencies detect:
                                                                [:dep|
                                                                 pkgver packageName = dep package name].
                        configVersion versionInfo versionNumber >= pkgver versionNumber]) ifTrue:
                                [^oldest].
                oldest := cfgver].
        self error: 'couldn''t find configuration newer than supplied versions'!

----- Method: SpurBootstrapMonticelloPackagePatcher>>from:to: (in category 'initialization') -----
from: sourceDirName to: destDirName
        sourceDir := self directoryFrom: sourceDirName.
        destDir := self directoryFrom: destDirName!

----- Method: SpurBootstrapMonticelloPackagePatcher>>imageTypes: (in category 'initialization') -----
imageTypes: typeArray
        imageTypes := typeArray!

----- Method: SpurBootstrapMonticelloPackagePatcher>>modifiedCharacterDefinitionsIn: (in category 'private-accessing') -----
modifiedCharacterDefinitionsIn: definitions
        | rewriter |
        rewriter := RBParseTreeRewriter new.
        rewriter
                replace: 'value' with: 'self asInteger';
                replace: 'value := ``@args' with: 'DELETEME'.
        ^(((definitions select: [:d| d isMethodDefinition and: [d fullClassName = #Character]])
                collect: [:d| { d. self patchDefinition: d withRewriter: rewriter} ]
                thenSelect: [:pair| pair first source ~= pair second source])
                        collect: [:pair| pair second])!

----- Method: SpurBootstrapMonticelloPackagePatcher>>modifiedFloatDefinitionsIn: (in category 'private-accessing') -----
modifiedFloatDefinitionsIn: definitions
        "Delete the non-accessing primitives in Float (prims 41 through 59),
         and copy them to BoxedFloat64,
         and create corresponding ones in SmallFloat64 with primtiive numbers + 500."
        | floatPrims |
        floatPrims := definitions select:
                                        [:d| | index |
                                        d isMethodDefinition
                                        and: [d fullClassName = #Float
                                        and: [(index := d source indexOfSubCollection: '<primitive: ') > 0
                                        and: [(Integer readFrom: (ReadStream on: d source from: index + '<primitive: ' size to: index + '<primitive: ' size + 4))
                                                        between: 41
                                                        and: 59]]]].
        ^(floatPrims collect:
                [:d|
                 MCMethodDefinition new
                        initializeWithClassName: d className
                        classIsMeta: false
                        selector: d selector
                        category: d category
                        timeStamp: d timeStamp
                        source: d source, 'DELETEME']),
         (floatPrims collect:
                [:d|
                 MCMethodDefinition new
                        initializeWithClassName: #BoxedFloat64
                        classIsMeta: false
                        selector: d selector
                        category: d category
                        timeStamp: d timeStamp
                        source: d source]),
         (floatPrims collect:
                [:d|
                 MCMethodDefinition new
                        initializeWithClassName: #SmallFloat64
                        classIsMeta: false
                        selector: d selector
                        category: d category
                        timeStamp: 'eem 11/25/2014 07:54'
                        source: (d source copyReplaceAll: '<primitive: ' with: '<primitive: 5')])!

----- Method: SpurBootstrapMonticelloPackagePatcher>>packageForMissingClassNamed: (in category 'accessing') -----
packageForMissingClassNamed: className
        (className = #BoxedFloat64
         or: [className = #SmallFloat64]) ifTrue:
                [^PackageInfo named: 'Kernel'].
        self error: 'unknown missing class'!

----- Method: SpurBootstrapMonticelloPackagePatcher>>packages (in category 'private-accessing') -----
packages
        "Answer the packages Spur modifies."
        ^self packagesAndPatches keys!

----- Method: SpurBootstrapMonticelloPackagePatcher>>packagesAndPatches (in category 'private-accessing') -----
packagesAndPatches
        "SpurBootstrapMonticelloPackagePatcher new packagesAndPatches"
        | spurBootstrap |
        packagesAndPatches ifNotNil:
                [^packagesAndPatches].
        packagesAndPatches := Dictionary new.
        spurBootstrap := SpurBootstrap new.
        imageTypes ifNotNil:
                [spurBootstrap imageTypes: imageTypes].
        spurBootstrap prototypeClassNameMetaSelectorMethodDo:
                [:className :isMeta :selector :method| | package category source definition |
                 (Smalltalk classNamed: className)
                        ifNil: [package := self packageForMissingClassNamed: className]
                        ifNotNil:
                                [:behavior| | class methodReference |
                                 class := isMeta ifTrue: [behavior class] ifFalse: [behavior].
                                 (class includesSelector: selector) ifTrue:
                                        [methodReference := (class >> selector) methodReference.
                                         category := methodReference category.
                                         category first = $* ifTrue:
                                                [category := nil]].
                                 package := (methodReference isNil
                                                          or: [methodReference category = Categorizer default
                                                          or: [methodReference category first = $*]]) "This for Scorch's override of InstructionClient>>classPrimitive:"
                                                                ifTrue: [PackageOrganizer default packageOfClass: class]
                                                                ifFalse: [PackageOrganizer default packageOfMethod: methodReference]].
                 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].
                 definition := MCAddition of: (MCMethodDefinition new
                                                                                initializeWithClassName: className
                                                                                classIsMeta: isMeta
                                                                                selector: selector
                                                                                category: (category ifNil: [SpurBootstrap
                                                                                                                                        categoryForClass: className
                                                                                                                                        meta: isMeta
                                                                                                                                        selector: selector])
                                                                                timeStamp: method timeStamp
                                                                                source: source).
                 (method pragmaAt: #remove) ifNotNil:
                        [definition := definition inverse].
                 (packagesAndPatches at: package ifAbsentPut: [OrderedCollection new])
                        add: definition].
        ^packagesAndPatches!

----- Method: SpurBootstrapMonticelloPackagePatcher>>patch (in category 'patching') -----
patch
        "(SpurBootstrapMonticelloPackagePatcher new
                        from: 'trunkpackages'
                        to: 'spurpackages')
                patch"
        "(SpurBootstrapMonticelloPackagePatcher new
                        from: '/Users/eliot/Squeak/Squeak4.5-spur/squeakv3-package-cache'
                        to: '/Users/eliot/Squeak/Squeak4.5-spur/package-cache')
                patch"
        "(SpurBootstrapMonticelloPackagePatcher new
                        from: '/Users/eliot/Glue/repositories/nsboot/Squeak4.3/squeak-package-cache'
                        to: '/Users/eliot/Glue/repositories/nsboot/Squeak4.3/package-cache')
                patch"
       
        sourceDir exists ifFalse:
                [self error: 'source directory doest not exist'].
        destDir assureExistence.
        self packagesAndPatches keysAndValuesDo:
                [:package :patches|
                 (self filesForPackage: package in: sourceDir) do:
                        [:packageFile|
                         self patchPackage: packageFile with: patches for: package]]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadAllInTrunk (in category 'patching') -----
patchAndUploadAllInTrunk
        "Look for all versions in the default repository that have patched versions there-in.
         Download and patch them and upload the patched versions (overwriting the older ones)."
        "(SpurBootstrapMonticelloPackagePatcher new
                from: 'trunkpackages'
                to: 'spurpackages')
                        patchAndUploadAllInTrunk"
        | seed trunk sourceRepo cacheRepo |
        seed := 'Are you really sure you want to do this?\It should happen only once!!' withCRs.
        3 timesRepeat:
                [(UIManager confirm: seed) ifFalse: [^self].
                 seed := seed copyReplaceAll: 'really ' with: 'really, really '].
        sourceDir assureExistence; deleteLocalFiles.
        destDir assureExistence; deleteLocalFiles.
        sourceRepo := MCDirectoryRepository directory: sourceDir.
        cacheRepo := MCCacheRepository default.
        (trunk := self trunk) cacheAllFileNamesDuring:
                [| latestBranches latestUnbranched |
                latestBranches := self packages collect:
                                                        [:package|
                                                        (trunk versionNamesForPackageNamed: package name, '.spur') detectMin: [:vn | vn asMCVersionName versionNumber]].
                latestUnbranched := latestBranches collect:
                                                                [:verName|
                                                                (trunk versionNamed: (verName copyReplaceAll: '.spur' with: '') asMCVersionName) info ancestors first versionName].
                ((trunk possiblyNewerVersionsOfAnyOf: latestUnbranched)
                        reject: [:unpatched| unpatched includesSubString: '.spur'])
                        do: [:unpatched|
                                "it is claimed that whether a repository contains a .mcz or a .mcd is irrelevant.  At least for the cache repository that's not true."
                                sourceRepo storeVersion: (self cachedNonDiffyVersionNamed: unpatched from: trunk)].
                 self patchAsNeeded.
                 self uploadFrom: (MCDirectoryRepository directory: destDir) to: trunk]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadNewer (in category 'patching') -----
patchAndUploadNewer
        "Look for unbranched versions on the default repository that are newer than the
         image''s versions. Download and patch them and upload the patched versions."
        "(SpurBootstrapMonticelloPackagePatcher new
                from: 'trunkpackages'
                to: 'spurpackages')
                        patchAndUploadNewer"
        | repo sourceRepo |
        sourceDir deleteLocalFiles.
        destDir deleteLocalFiles.
        repo := self repositoryForUrl: MCMcmUpdater defaultUpdateURL.
        sourceRepo := MCDirectoryRepository directory: sourceDir.
        repo cacheAllFileNamesDuring:
                [self packages do:
                        [:package| | workingCopy |
                        workingCopy := MCWorkingCopy allManagers detect: [:pkg| pkg packageName = package packageName].
                        (workingCopy possiblyNewerVersionsIn: repo) do:
                                [:newerVersion|
                                 newerVersion packageAndBranchName = package packageName ifTrue: "Don't patch already patched packages!!!!"
                                        [(sourceRepo includesVersionNamed: newerVersion) ifFalse:
                                                [sourceRepo storeVersion: (repo versionNamed: newerVersion)]]]].
                 self patchAsNeeded.
                 self uploadFrom: (MCDirectoryRepository directory: destDir) to: repo]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadUnpatchedInTrunk (in category 'patching') -----
patchAndUploadUnpatchedInTrunk
        "Look for unbranched versions in the default repository that are newer than the
         latest patched versions there-in. Download and patch them and upload the patched
         versions."
        "(SpurBootstrapMonticelloPackagePatcher new
                from: 'trunkpackages'
                to: 'spurpackages')
                        patchAndUploadUnpatchedInTrunk"
        | trunk sourceRepo cacheRepo |
        sourceDir assureExistence; deleteLocalFiles.
        destDir assureExistence; deleteLocalFiles.
        sourceRepo := MCDirectoryRepository directory: sourceDir.
        cacheRepo := MCCacheRepository default.
        (trunk := self trunk) cacheAllFileNamesDuring:
                [| latestBranches latestUnbranched |
                latestBranches := self packages collect:
                                                        [:package|
                                                        (trunk versionNamesForPackageNamed: package name, '.spur') detectMax: [:vn | vn asMCVersionName versionNumber]]
                                                        thenSelect: [:branch| branch notNil].
                latestUnbranched := latestBranches collect: [:verName| (verName copyReplaceAll: '.spur' with: '') asMCVersionName].
                ((trunk possiblyNewerVersionsOfAnyOf: latestUnbranched)
                        reject: [:unpatched| unpatched includesSubString: '.spur'])
                        do: [:unpatched|
                                "it is claimed that whether a repository contains a .mcz or a .mcd is irrelevant.  At least for the cache repositoriy that's not true."
                                sourceRepo storeVersion: (self cachedNonDiffyVersionNamed: unpatched from: trunk)].
                 self patchAsNeeded.
                 self uploadFrom: (MCDirectoryRepository directory: destDir) to: trunk]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAsNeeded (in category 'patching') -----
patchAsNeeded
        (sourceDir exists and: [destDir exists]) ifFalse:
                [self error: 'one or both of the directories don''t exist'].
        self packagesAndPatches keysAndValuesDo:
                [:package :patches|
                 (self filesForPackage: package in: sourceDir) do:
                        [:packageFile| | spurPackageFile |
                         spurPackageFile := self spurBranchNameForInfo: packageFile package: package.
                         ((destDir includesKey: packageFile) or: [destDir includesKey: spurPackageFile])
                                ifTrue:
                                        [Transcript
                                                cr; nextPutAll: destDir fullName; nextPutAll: ' contains either ';
                                                nextPutAll: packageFile; nextPutAll: ' or '; nextPutAll: spurPackageFile;
                                                nextPutAll: '; not saving'; flush]
                                ifFalse:
                                        [self patchPackage: packageFile with: patches for: package]]]

        "| patcher |
         patcher := SpurBootstrapMonticelloPackagePatcher new
                                        from: 'trunkpackages'
                                        to: 'spurpackages'.
        patcher trunk cacheAllFileNamesDuring:
                [patcher patchAsNeeded]"!

----- Method: SpurBootstrapMonticelloPackagePatcher>>patchDefinition:withRewriter: (in category 'patching') -----
patchDefinition: aMCMethodDefinition withRewriter: aRBParseTreeRewriter
        | parseTree |
        parseTree := RBParser
                                        parseMethod: aMCMethodDefinition source
                                        onError: [:str :pos | self halt].
        aRBParseTreeRewriter executeTree: parseTree.
        ^MCMethodDefinition new
                initializeWithClassName: aMCMethodDefinition className
                classIsMeta:aMCMethodDefinition classIsMeta
                selector: aMCMethodDefinition selector
                category: aMCMethodDefinition category
                timeStamp: aMCMethodDefinition timeStamp
                source: aRBParseTreeRewriter tree newSource!

----- Method: SpurBootstrapMonticelloPackagePatcher>>patchFile: (in category 'patching') -----
patchFile: packageFile
        "(SpurBootstrapMonticelloPackagePatcher new
                        from: '/Users/eliot/oscogvm/image/package-cache'
                        to: '/Users/eliot/oscogvm/image/spurpackages')
                patchFile: 'Collections-ul.573(nice.572).mcd'"
       
        sourceDir exists ifFalse:
                [self error: 'source directory doest not exist'].
        destDir assureExistence.
        self packagesAndPatches keysAndValuesDo:
                [:package :patches|
                 ((packageFile beginsWith: package name)
                  and: [(packageFile at: package name size + 1) isLetter not]) ifTrue:
                        [self patchPackage: packageFile with: patches for: package]]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>patchPackage:with:for: (in category 'patching') -----
patchPackage: packageFileName with: patches for: package
        | version newVersion |
        version := self versionFor: packageFileName in: sourceDir.
        newVersion := self version: version withPatches: patches for: package.
        self storeVersion: newVersion!

----- Method: SpurBootstrapMonticelloPackagePatcher>>patches:forSnapshot: (in category 'patching') -----
patches: basePatches forSnapshot: snapshot
        "Add modified class defs for Character, SmallInteger, Float, BoxedFloat64, SmallFloat64 and COmpiledMethod.
         Remove ObjectHistory and ObjectHistoryMark (which Spur does not support)."
        | patches defs |
        patches  := basePatches copy.
        defs := snapshot definitions.
        (defs anySatisfy: [:d| d isClassDefinition and: [d className == #Character]]) ifTrue:
                [patches
                        addAll: (self filteredDefinitionsAsPatches: (self modifiedCharacterDefinitionsIn: snapshot definitions)
                                                patches: patches);
                        add: (self
                                        classDefinitionFor: #Character
                                        type: #immediate
                                        from: snapshot definitions
                                        comment: 'I represent a character by storing its associated Unicode as an unsigned 30-bit value.  Characters are created uniquely, so that all instances of a particular Unicode are identical.  My instances are encoded in tagged pointers in the VM, so called immediates, and therefore are pure immutable values.

        The code point is based on Unicode.  Since Unicode is 21-bit wide character set, we have several bits available for other information.  As the Unicode Standard  states, a Unicode code point doesn''t carry the language information.  This is going to be a problem with the languages so called CJK (Chinese, Japanese, Korean.  Or often CJKV including Vietnamese).  Since the characters of those languages are unified and given the same code point, it is impossible to display a bare Unicode code point in an inspector or such tools.  To utilize the extra available bits, we use them for identifying the languages.  Since the old implementation uses the bits to identify the character encoding, the bits are sometimes called "encoding tag" or neutrally "leading char", but the bits rigidly denotes the concept of languages.

        The other languages can have the language tag if you like.  This will help to break the large default font (font set) into separately loadable chunk of fonts.  However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false.'
                                        stamp: 'eem 8/12/2014 14:53')].
        (defs anySatisfy: [:def| def isClassDefinition and: [def className == #SmallInteger]]) ifTrue:
                [patches
                        add: (self
                                        classDefinitionFor: #SmallInteger
                                        type: #immediate
                                        from: snapshot definitions
                                        comment: 'My instances are at least 31-bit numbers, stored in twos complement form. The allowable range in 32-bits is approximately +- 10^9 (+- 1billion).  In 64-bits my instances are 61-bit numbers, stored in twos complement form. The allowable range is approximately +- 10^18 (+- 1 quintillion).   The actual values are computed at start-up.  See SmallInteger class startUp:, minVal, maxVal.'
                                        stamp: 'eem 11/20/2014 08:41')].
        (defs anySatisfy: [:def| def isClassDefinition and: [def className == #Float]]) ifTrue:
                [patches
                        add: (self
                                        classDefinitionFor: #Float
                                        type: #normal
                                        from: snapshot definitions
                                        comment: nil
                                        stamp: nil);
                        add: (self
                                        classDefinitionFor: #BoxedFloat64
                                        type: #words
                                        from: snapshot definitions
                                        comment: 'My instances hold 64-bit Floats in heap objects.  This is the only representation on 32-bit systems.  But on 64-bit systems SmallFloat64 holds a subset of the full 64-bit double-precision range in immediate objects.'
                                        stamp: 'eem 11/25/2014 07:54');
                        add: (self
                                        classDefinitionFor: #SmallFloat64
                                        type: #immediate
                                        from: snapshot definitions
                                        comment: 'My instances represent 64-bit Floats whose exponent fits in 8 bits as immediate objects.  This representation is only available on 64-bit systems, not 32-bit systems.'
                                        stamp: 'eem 11/25/2014 07:54');
                        addAll: (self filteredDefinitionsAsPatches: (self modifiedFloatDefinitionsIn: snapshot definitions)
                                                patches: patches)].
        (defs anySatisfy: [:def| def isClassDefinition and: [def className == #CompiledMethod]]) ifTrue:
                [patches
                        add: self compiledMethodClassDefinition].
        (defs anySatisfy: [:def| def isClassDefinition and: [def className == #ObjectHistory]]) ifTrue:
                [patches addAll:
                        (defs
                                select: [:def| #(ObjectHistory ObjectHistoryMark) includes: def className]
                                thenCollect: [:def| MCRemoval of: def])].
        ^MCPatch operations: patches!

----- Method: SpurBootstrapMonticelloPackagePatcher>>repositoryForUrl: (in category 'repository population') -----
repositoryForUrl: url
        ^MCRepositoryGroup default repositories
                detect: [:r| r description = url]
                ifNone: [MCHttpRepository
                                        location: url
                                        user: 'squeak'
                                        password: 'squeak']!

----- Method: SpurBootstrapMonticelloPackagePatcher>>spurBranchNameForInfo:package: (in category 'patching') -----
spurBranchNameForInfo: versionInfoOrString package: package
        ^(versionInfoOrString isString
                ifTrue: [versionInfoOrString]
                ifFalse: [versionInfoOrString name]) copyReplaceAll: package name with: package name, '.spur'!

----- Method: SpurBootstrapMonticelloPackagePatcher>>spurConfigurationOf:forRepository: (in category 'configurations') -----
spurConfigurationOf: anMCConfiguration forRepository: repo
        "Answer a copy of anMCConfiguration containing the matching Spur dependencies.
         If no replacements could be made (because no Spur versions exist) then answer nil."
        | found clone |
        found := false.
        clone := Array streamContents:
                                [:s|
                                s nextPut: #name; nextPut: (anMCConfiguration name copyReplaceAll: 'update-' with: 'update.spur-');
                                 "no location accessor!!!!"
                                  nextPut: #repository; nextPut: {anMCConfiguration repositories first locationWithTrailingSlash allButLast}.
                                 anMCConfiguration dependencies do:
                                        [:dep| | info pkg ver spurVersionName |
                                         info := dep versionInfo.
                                         ((pkg := self packages
                                                                detect: [:package| package name = dep package name]
                                                                ifNone: []) notNil
                                          and: [spurVersionName := (info name
                                                                                                        copyReplaceAll: pkg name
                                                                                                        with: pkg name, '.spur'), '.mcz'.
                                                 (ver := MCCacheRepository default versionNamed: spurVersionName asMCVersionName) ifNil:
                                                        [ver := repo versionNamed: spurVersionName asMCVersionName].
                                                 ver notNil])
                                                ifTrue: [found := true. info := ver info].
                                        (ver isNil and: [spurVersionName notNil]) ifTrue:
                                                [Transcript nextPutAll: 'failed to get ', spurVersionName, ' in ', anMCConfiguration name; cr; flush.
                                                 self error: 'failed to get ', spurVersionName, ' in ', anMCConfiguration name].
                                        s nextPut: #dependency; nextPut: (MCConfiguration dependencyToArray: (MCVersionDependency package: dep package info: info))]].
        ^found ifTrue:
                [MCConfiguration fromArray: clone]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>storeVersion: (in category 'patching') -----
storeVersion: newVersion
        [(MCDirectoryRepository new directory: destDir) storeVersion: newVersion]
                on: FileExistsException
                do: [:ex| ex resume: (ex fileClass forceNewFileNamed: ex fileName)]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>trunk (in category 'repository population') -----
trunk
        ^self repositoryForUrl: 'http://source.squeak.org/trunk'!

----- Method: SpurBootstrapMonticelloPackagePatcher>>uploadFrom:to: (in category 'repository population') -----
uploadFrom: localRepo to: uploadRepository
        localRepo allVersionsDo:
                [:version|
                (uploadRepository includesVersionNamed: version info name) ifFalse:
                        [uploadRepository storeVersion: version]]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>uploadNewerSpurConfigurationsInTrunk (in category 'configurations') -----
uploadNewerSpurConfigurationsInTrunk
        "Make sure that update.spur configurations exist for all relevant update.* configurations."
        "SpurBootstrapMonticelloPackagePatcher new uploadNewerSpurConfigurationsInTrunk"
        | trunk |
        trunk := self trunk.
        trunk cacheAllFileNamesDuring:
                [| configurations spurConfigurations oldestUpdate |
                 spurConfigurations := (trunk versionNamesForPackageNamed: 'update.spur') sort: [:a :b| a versionNumber > b versionNumber].
                 configurations := ((trunk versionNamesForPackageNamed: 'update') select: [:n| n beginsWith: 'update-']) sort: [:a :b| a versionNumber > b versionNumber].
                 oldestUpdate := spurConfigurations isEmpty
                                                        ifTrue:
                                                                [| earliestBranches earliestUnbranched  |
                                                                 earliestBranches := self packages collect:
                                                                                                                [:package|
                                                                                                                (trunk versionNamesForPackageNamed: package name, '.spur') detectMin:
                                                                                                                        [:vn | vn asMCVersionName versionNumber]].
                                                                 earliestUnbranched := earliestBranches collect:
                                                                                                                        [:verName| (verName copyReplaceAll: '.spur' with: '') asMCVersionName].
                                                                 self
                                                                        findOldestConfigurationFor: earliestUnbranched
                                                                        inVersionNames: configurations
                                                                        repository: trunk]
                                                        ifFalse:
                                                                [spurConfigurations first copyReplaceAll: '.spur' with: ''].
                 Transcript nextPutAll: 'Oldest: ', oldestUpdate; cr; flush.
                 (configurations copyFrom: 1 to: (configurations indexOf: oldestUpdate) - 1) reverseDo:
                        [:configName|
                         "((configName beginsWith: 'update-eem.29') and: ['34' includes: (configName at: 14)]) ifTrue:
                                [self halt]."
                         (self spurConfigurationOf: (trunk versionNamed: configName) forRepository: trunk) ifNotNil:
                                [:edition| trunk storeVersion: edition]]]!

----- Method: SpurBootstrapMonticelloPackagePatcher>>version:withPatches:for: (in category 'patching') -----
version: version withPatches: patches for: package
        | snapshot ancestry possibleSpurAncestor actualAncestor |
        snapshot := MCPatcher
                                        apply: (self patches: patches forSnapshot: version snapshot)
                                        to: version snapshot.
        ancestry := MCWorkingAncestry new addAncestor: version info.
        "this is a hack; we may not be patching w.r.t. a directory or trunk"
        possibleSpurAncestor := (self spurBranchNameForInfo: version info ancestors first package: package) , '.mcz'.
        (destDir includesKey: possibleSpurAncestor)
                ifTrue:
                        [actualAncestor := self versionFor: possibleSpurAncestor in: destDir]
                ifFalse:
                        [((self trunk versionNamesForPackageNamed: package name) includes: possibleSpurAncestor) ifTrue:
                                [actualAncestor := self trunk versionNamed: possibleSpurAncestor]].
        actualAncestor ifNotNil:
                [ancestry addAncestor: actualAncestor info].
        ^MCVersion
                package: version package
                info: (ancestry
                                infoWithName: (self spurBranchNameForInfo: version info package: package)
                                message: version info name,
                                                        ' patched for Spur by ',
                                                        (CCodeGenerator shortMonticelloDescriptionForClass: self class),
                                                        '\\' withCRs,
                                                        version info message)
                snapshot: snapshot
                dependencies: {} "punt on computing dependencies; there are't any so far"!

----- Method: SpurBootstrapMonticelloPackagePatcher>>versionFor:in: (in category 'patching') -----
versionFor: packageFileName in: directory
        ^directory
                readOnlyFileNamed: packageFileName
                do: [:fs|
                        ((MCVersionReader readerClassForFileNamed: fs fullName)
                                on: fs fileName: fs fullName)
                                        version]!

Object subclass: #SpurBootstrapNewspeakFilePatcher
        instanceVariableNames: 'source substitutions'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Bootstrapping'!

----- 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]!

----- Method: SpurBootstrapNewspeakFilePatcher>>findClassDeclarationFor:in: (in category 'parsing') -----
findClassDeclarationFor: className in: ast "<ClassDeclarationAST>" "^(ClassDeclarationAST|nil)"
        ^ast instanceSide nestedClasses
                detect: [:classDecl| classDecl name = className]
                ifNone: []!

----- 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!

----- Method: SpurBootstrapNewspeakFilePatcher>>initialize (in category 'initialize-release') -----
initialize
        substitutions := SortedCollection sortBlock: [:tupleA :tupleB | tupleA first <= tupleB first]!

----- 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].

        "map assignments to Newspeak format"
        startIndex := 1.
        [(startIndex := source indexOfSubCollection: ':=' startingAt: startIndex) > 0] whileTrue:
                [nextIndex := startIndex.
                 [(source at: nextIndex - 1) isSeparator] whileTrue:
                        [nextIndex := nextIndex - 1].
                 source := source copyReplaceFrom: nextIndex to: startIndex + 1 with: '::'.
                 startIndex := nextIndex + 1].

        "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!

----- 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]!

----- 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')!

----- 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}]]]]!

Object subclass: #SpurBootstrapPrototypes
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Bootstrapping'!

SpurBootstrapPrototypes subclass: #SpurBootstrapPharoPrototypes
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Bootstrapping'!

----- Method: SpurBootstrapPharoPrototypes class>>imageType (in category 'accessing') -----
imageType
        ^ 'pharo'!

----- Method: SpurBootstrapPharoPrototypes>>BehaviorPROTOTYPEbasicIdentityHash (in category 'method prototypes') -----
BehaviorPROTOTYPEbasicIdentityHash
        "Answer a SmallInteger whose value is related to the receiver's identity.
         Behavior implements identityHash to allow the VM to use an object representation which
         does not include a direct reference to an object's class in an object.  If the VM is using
         this implementation then classes are held in a class table and instances contain the index
         of their class in the table.  A class's class table index is its identityHash so that an instance
         can be created without searching the table for a class's index.  The VM uses this primitive
         to enter the class into the class table, assigning its identityHash with an as yet unused
         class table index. If this primitive fails it means that the class table is full.  In Spur as of
         2014 there are 22 bits of classTable index and 22 bits of identityHash per object.

         Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."

        <primitive: 175>
        self primitiveFailed!

----- Method: SpurBootstrapPharoPrototypes>>BehaviorPROTOTYPElargeIdentityHash (in category 'method prototypes') -----
BehaviorPROTOTYPElargeIdentityHash
        "Answer a SmallInteger whose value is related to the receiver's identity.
         Behavior implements identityHash to allow the VM to use an object representation which
         does not include a direct reference to an object's class in an object.  If the VM is using
         this implementation then classes are held in a class table and instances contain the index
         of their class in the table.  A class's class table index is its identityHash so that an instance
         can be created without searching the table for a class's index.  The VM uses this primitive
         to enter the class into the class table, assigning its identityHash with an as yet unused
         class table index. If this primitive fails it means that the class table is full.  In Spur as of
         2014 there are 22 bits of classTable index and 22 bits of identityHash per object."

        <primitive: 175>
        self primitiveFailed!

----- Method: SpurBootstrapPharoPrototypes>>BlockClosurePHAROPROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
BlockClosurePHAROPROTOTYPEsimulateValueWithArguments: anArray caller: aContext
        <indirect>!

----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEcodePoint (in category 'method prototypes') -----
CharacterPROTOTYPEcodePoint
        "Just for ANSI Compliance"
        ^self asciiValue!

----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
CharacterPROTOTYPEsetValue: newValue
        self error: 'Characters are immutable'!

----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
CharacterPROTOTYPEshallowCopy
        "Answer the receiver, because Characters are unique."
        ^self!

----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
ContextPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: aReceiver args: arguments
        <indirect>!

----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
ContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
        <indirect>!

----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
ContextPROTOTYPEisPrimFailToken: anObject
        <indirect>
!

----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEobjectClass: (in category 'method prototypes') -----
ContextPROTOTYPEobjectClass: aReceiver
        <indirect>!

----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
ContextPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
        "Simulate the action of sending a message with selector and arguments
         to rcvr. The argument, lookupClass, is the class in which to lookup the
         message.  This is the receiver's class for normal messages, but for super
         messages it will be some specific class related to the source method."

        | meth primIndex val ctxt |
        (meth := lookupClass lookupSelector: selector) ifNil:
                [^self send: #doesNotUnderstand:
                                to: rcvr
                                with: {Message selector: selector arguments: arguments}
                                lookupIn: lookupClass].
        (primIndex := meth primitive) > 0 ifTrue:
                [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
                 (self isPrimFailToken: val) ifFalse:
                        [^val]].
        (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
                [^self error: 'Simulated message ', arguments first selector, ' not understood'].
        ctxt := Context sender: self receiver: rcvr method: meth arguments: arguments.
        primIndex > 0 ifTrue:
                [ctxt failPrimitiveWith: val].
        ^ctxt!

----- Method: SpurBootstrapPharoPrototypes>>ContextclassPROTOTYPEallInstances (in category 'method prototypes') -----
ContextclassPROTOTYPEallInstances
        "Answer all instances of the receiver."
        <primitive: 177>
        "The primitive can fail because memory is low.  If so, fall back on the old
         enumeration code, which gives the system a chance to GC and/or grow.
         Because aBlock might change the class of inst (for example, using become:),
         it is essential to compute next before aBlock value: inst.
         Only count until thisContext since this context has been created only to
         compute the existing instances."
        | inst insts next |
        insts := WriteStream on: (Array new: 64).
        inst := self someInstance.
        [inst == thisContext or: [inst == nil]] whileFalse:
                [next := inst nextInstance.
                 insts nextPut: inst.
                 inst := next].
        ^insts contents!

----- Method: SpurBootstrapPharoPrototypes>>ContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
ContextclassPROTOTYPEallInstancesDo: aBlock
        "Evaluate aBlock with each of the current instances of the receiver."
        | instances inst next |
        instances := self allInstancesOrNil.
        instances ifNotNil:
                [instances do: aBlock.
                 ^self].
        "allInstancesOrNil can fail because memory is low.  If so, fall back on the old
         enumeration code.  Because aBlock might change the class of inst (for example,
         using become:), it is essential to compute next before aBlock value: inst.
         Only count until thisContext since evaluation of aBlock will create new contexts."
        inst := self someInstance.
        [inst == thisContext or: [inst == nil]] whileFalse:
                [next := inst nextInstance.
                 aBlock value: inst.
                 inst := next]!

----- Method: SpurBootstrapPharoPrototypes>>ProtoObjectPROTOTYPEidentityHash (in category 'method prototypes') -----
ProtoObjectPROTOTYPEidentityHash
        "Answer a SmallInteger whose value is related to the receiver's identity.
         This method must not be overridden, except by SmallInteger.  As of
         2014, the 32-bit Spur VM has 22 bits of hash and 31-bit SmallIntegers
         (30 bits + 1 sign bit).  Shifting by 8 will not create large integers.
       
         Do not override."

        ^self basicIdentityHash bitShift: 8!

----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
SlotClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
        "Compute the new format for making oldClass a subclass of newSuper.
         Answer the format or nil if there is any problem."
        | instSize isVar isWords isPointers isWeak |
        type == #compiledMethod ifTrue:
                [newInstSize > 0 ifTrue:
                        [self error: 'A compiled method class cannot have named instance variables'.
                        ^nil].
                ^CompiledMethod format].
        instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
        instSize > 65535 ifTrue:
                [self error: 'Class has too many instance variables (', instSize printString,')'.
                ^nil].
        type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
        type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
        type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
        type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
        type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
        type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
        type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
        (isPointers not and: [instSize > 0]) ifTrue:
                [self error: 'A non-pointer class cannot have named instance variables'.
                ^nil].
        ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!

----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
SlotClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
        "Compute the format for the given instance specfication.
         Above Cog Spur the class format is
                <5 bits inst spec><16 bits inst size>
         where the 5-bit inst spec is
                        0 = 0 sized objects (UndefinedObject True False et al)
                        1 = non-indexable objects with inst vars (Point et al)
                        2 = indexable objects with no inst vars (Array et al)
                        3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
                        4 = weak indexable objects with inst vars (WeakArray et al)
                        5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
                        6 = unused
                        7 = immediates (SmallInteger, Character)
                        8 = unused
                        9 = reserved for 64-bit indexable
                10-11 = 32-bit indexable (Bitmap)
                12-15 = 16-bit indexable
                16-23 = 8-bit indexable
                24-31 = compiled methods (CompiledMethod)"
        | instSpec |
        instSpec := isWeak
                                        ifTrue:
                                                [isVar
                                                        ifTrue: [4]
                                                        ifFalse: [5]]
                                        ifFalse:
                                                [isPointers
                                                        ifTrue:
                                                                [isVar
                                                                        ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
                                                                        ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
                                                        ifFalse:
                                                                [isVar
                                                                        ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
                                                                        ifFalse: [7]]].
        ^(instSpec bitShift: 16) + nInstVars!

----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
SlotClassBuilderPROTOTYPEsuperclass: aClass
        immediateSubclass: t instanceVariableNames: f
        classVariableNames: d poolDictionaries: s category: cat
        "This is the standard initialization message for creating a
         new immediate class as a subclass of an existing class."
        | env |
        aClass instSize > 0
                ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
        aClass isVariable
                ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
        aClass isPointers
                ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
        "Cope with pre-environment and environment versions. Simplify asap."
        env := (Smalltalk classNamed: #EnvironmentRequest)
                                ifNil: [aClass environment]
                                ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
        ^self
                name: t
                inEnvironment: env
                subclassOf: aClass
                type: #immediate
                instanceVariableNames: f
                classVariableNames: d
                poolDictionaries: s
                category: cat!

----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
SlotClassBuilderPROTOTYPEupdate: oldClass to: newClass
        "Convert oldClass, all its instances and possibly its meta class into newClass,
         instances of newClass and possibly its meta class. The process is surprisingly
         simple in its implementation and surprisingly complex in its nuances and potentially
         bad side effects.
         We can rely on two assumptions (which are critical):
                #1: The method #updateInstancesFrom: will not create any lasting pointers to
                         'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
                         a become of the old vs. the new instances and therefore it will not create
                         pointers to *new* instances before the #become: which are *old* afterwards)
                #2: The non-preemptive execution of the critical piece of code guarantees that
                         nobody can get a hold by 'other means' (such as process interruption and
                         reflection) on the old instances.
         Given the above two, we know that after #updateInstancesFrom: there are no pointers
         to any old instances. After the forwarding become there will be no pointers to the old
         class or meta class either.
         Andreas Raab, 2/27/2003 23:42"
        | meta |
        meta := oldClass isMeta.
        "Note: Everything from here on will run without the ability to get interrupted
        to prevent any other process to create new instances of the old class."
        ["Note: The following removal may look somewhat obscure and needs an explanation.
          When we mutate the class hierarchy we create new classes for any existing subclass.
          So it may look as if we don't have to remove the old class from its superclass. However,
          at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
          created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
          subclasses. Since the #become: below will transparently replace the pointers to oldClass
          with newClass the superclass would have newClass in its subclasses TWICE. With rather
          unclear effects if we consider that we may convert the meta-class hierarchy itself (which
          is derived from the non-meta class hierarchy).
          Due to this problem ALL classes are removed from their superclass just prior to converting
          them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
          effectively remove the oldClass (becomeForward:) just a few lines below."

                oldClass superclass removeSubclass: oldClass.
                oldClass superclass removeObsoleteSubclass: oldClass.

                "make sure that the VM cache is clean"
                oldClass methodDict do: [:cm | cm flushCache].
               
                "Convert the instances of oldClass into instances of newClass"
                newClass updateInstancesFrom: oldClass.

                meta
                        ifTrue:
                                [oldClass becomeForward: newClass.
                                 oldClass updateMethodBindingsTo: oldClass binding]
                        ifFalse:
                                [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
                                 oldClass updateMethodBindingsTo: oldClass binding.
                                 oldClass class updateMethodBindingsTo: oldClass class binding].

                "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
                 to ensure no old instances existed after the becomeForward:.  Without the GC it was possible
                 to resurrect old instances using e.g. allInstancesDo:.  This was because the becomeForward:
                 updated references from the old objects to new objects but didn't destroy the old objects.
                 But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
                        valueUnpreemptively!

----- Method: SpurBootstrapPharoPrototypes>>SmalltalkImagePROTOTYPEnewSpecialObjectsArray (in category 'method prototypes') -----
SmalltalkImagePROTOTYPEnewSpecialObjectsArray
        "Smalltalk recreateSpecialObjectsArray"
       
        "To external package developers:
        **** DO NOT OVERRIDE THIS METHOD.  *****
        If you are writing a plugin and need additional special object(s) for your own use,
        use addGCRoot() function and use own, separate special objects registry "
       
        "The Special Objects Array is an array of objects used by the Squeak virtual machine.
         Its contents are critical and accesses to it by the VM are unchecked, so don't even
         think of playing here unless you know what you are doing."
        | newArray |
        newArray := Array new: 60.
        "Nil false and true get used throughout the interpreter"
        newArray at: 1 put: nil.
        newArray at: 2 put: false.
        newArray at: 3 put: true.
        "This association holds the active process (a ProcessScheduler)"
        newArray at: 4 put: (self globals associationAt: #Processor).
        "Numerous classes below used for type checking and instantiation"
        newArray at: 5 put: Bitmap.
        newArray at: 6 put: SmallInteger.
        newArray at: 7 put: ByteString.
        newArray at: 8 put: Array.
        newArray at: 9 put: Smalltalk.
        newArray at: 10 put: Float.
        newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
        newArray at: 12 put: nil. "was BlockContext."
        newArray at: 13 put: Point.
        newArray at: 14 put: LargePositiveInteger.
        newArray at: 15 put: Display.
        newArray at: 16 put: Message.
        newArray at: 17 put: CompiledMethod.
        newArray at: 18 put: ((self primitiveGetSpecialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
        newArray at: 19 put: Semaphore.
        newArray at: 20 put: Character.
        newArray at: 21 put: #doesNotUnderstand:.
        newArray at: 22 put: #cannotReturn:.
        newArray at: 23 put: nil. "This is the process signalling low space."
        "An array of the 32 selectors that are compiled as special bytecodes,
         paired alternately with the number of arguments each takes."
        newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
                                                        #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
                                                        #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
                                                        #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
        "An array of the 255 Characters in ascii order.
         Cog inlines table into machine code at: prim so do not regenerate it.
         This is nil in Spur, which has immediate Characters."
        newArray at: 25 put: (self primitiveGetSpecialObjectsArray at: 25).
        newArray at: 26 put: #mustBeBoolean.
        newArray at: 27 put: ByteArray.
        newArray at: 28 put: Process.
        "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
        newArray at: 29 put: self compactClassesArray.
        newArray at: 30 put: ((self primitiveGetSpecialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
        newArray at: 31 put: ((self primitiveGetSpecialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
        "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
        newArray at: 32 put: nil. "was the prototype Float"
        newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
        newArray at: 34 put: nil. "was the prototype Point"
        newArray at: 35 put: #cannotInterpret:.
        newArray at: 36 put: nil. "was the prototype MethodContext"
        newArray at: 37 put: BlockClosure.
        newArray at: 38 put: nil. "was the prototype BlockContext"
        "array of objects referred to by external code"
        newArray at: 39 put: (self primitiveGetSpecialObjectsArray at: 39). "external semaphores"
        newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
        newArray at: 41 put: ((self primitiveGetSpecialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
        newArray at: 42 put: ((self primitiveGetSpecialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
        newArray at: 43 put: LargeNegativeInteger.
        "External objects for callout.
         Note: Written so that one can actually completely remove the FFI."
        newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
        newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
        newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
        newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
        newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
        newArray at: 49 put: #aboutToReturn:through:.
        newArray at: 50 put: #run:with:in:.
        "51 reserved for immutability message"
        newArray at: 51 put: #attemptToAssign:withIndex:.
        newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
                                                        #'bad argument' #'bad index'
                                                        #'bad number of arguments'
                                                        #'inappropriate operation'  #'unsupported operation'
                                                        #'no modification' #'insufficient object memory'
                                                        #'insufficient C memory' #'not found' #'bad method'
                                                        #'internal error in named primitive machinery'
                                                        #'object may move' #'resource limit exceeded'
                                                        #'object is pinned' #'primitive write beyond end of object').
        "53 to 55 are for Alien"
        newArray at: 53 put: (self at: #Alien ifAbsent: []).
        newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
        newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).

        "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
        newArray at: 56 put: nil.

        "reserved for foreign callback process"
        newArray at: 57 put: (self primitiveGetSpecialObjectsArray at: 57 ifAbsent: []).

        newArray at: 58 put: #unusedBytecode.
        "59 reserved for Sista counter tripped message"
        newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
        "60 reserved for Sista class trap message"
        newArray at: 60 put: #classTrapFor:.

        ^newArray!

----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
TraitBehaviorPROTOTYPEallInstances
        "Answer all instances of the receiver."
        self error: 'Traits does not have instances.'!

----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
TraitBehaviorPROTOTYPEallInstancesDo: aBlock
        "Evaluate aBlock with each of the current instances of the receiver."
        self error: 'Traits does not have instances.'!

----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
TraitBehaviorPROTOTYPEinstSpec
        "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)"
        ^(self format bitShift: -16) bitAnd: 16r1F!

----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisBits (in category 'method prototypes') -----
TraitBehaviorPROTOTYPEisBits
        "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!

----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisBytes (in category 'method prototypes') -----
TraitBehaviorPROTOTYPEisBytes
        "Answer whether the receiver has 8-bit instance variables.
         Above Cog Spur the class format is
                <5 bits inst spec><16 bits inst size>
         where the 5-bit inst spec is
                        0 = 0 sized objects (UndefinedObject True False et al)
                        1 = non-indexable objects with inst vars (Point et al)
                        2 = indexable objects with no inst vars (Array et al)
                        3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
                        4 = weak indexable objects with inst vars (WeakArray et al)
                        5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
                        6 = unused
                        7 = immediates (SmallInteger, Character)
                        8 = unused
                        9 = 64-bit indexable
                10-11 = 32-bit indexable (Bitmap)
                12-15 = 16-bit indexable
                16-23 = 8-bit indexable
                24-31 = compiled methods (CompiledMethod)"
        ^self instSpec >= 16!

----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') -----
TraitBehaviorPROTOTYPEisEphemeronClass
        "Answer whether the receiver has ephemeral instance variables.  The garbage collector will
         fire (queue for finalization) any ephemeron whose first instance variable is not referenced
         other than from the transitive closure of references from ephemerons. Hence referring to
         an object from the first inst var of an ephemeron will cause the ephemeron to fire when
         the rest of the system does not refer to the object and that object is ready to be collected.
         Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
         from firing, ephemerons may act as the associations in weak dictionaries such that the value
         (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
         other than from ephemerons.  Ephemerons can therefore be used to implement instance-based
         pre-mortem finalization."
        ^self instSpec = 5!

----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') -----
TraitBehaviorPROTOTYPEisImmediateClass
        "Answer whether the receiver has immediate instances.  Immediate instances
         store their value in their object pointer, not in an object body.  Hence immediates
         take no space and are immutable.  The immediates are distinguished by tag bits
         in the pointer. They include SmallIntegers and Characters.  Hence in the 32-bit
         system SmallIntegers are 31-bit signed integers and Characters are 30-bit
         unsigned character codes."
        ^self instSpec = 7!

----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisVariable (in category 'method prototypes') -----
TraitBehaviorPROTOTYPEisVariable
        "Answer whether the receiver has indexable variables.
         Above Cog Spur the class format is
                <5 bits inst spec><16 bits inst size>
         where the 5-bit inst spec is
                        0 = 0 sized objects (UndefinedObject True False et al)
                        1 = non-indexable objects with inst vars (Point et al)
                        2 = indexable objects with no inst vars (Array et al)
                        3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
                        4 = weak indexable objects with inst vars (WeakArray et al)
                        5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
                        6 = unused
                        7 = immediates (SmallInteger, Character)
                        8 = unused
                        9 = 64-bit indexable
                10-11 = 32-bit indexable (Bitmap)
                12-15 = 16-bit indexable
                16-23 = 8-bit indexable
                24-31 = compiled methods (CompiledMethod)"
        | instSpec |
        instSpec := self instSpec.
        ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!

----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
TraitBehaviorPROTOTYPEkindOfSubclass
        "Answer a String that is the keyword that describes the receiver's kind of subclass,
         either a regular subclass, a variableSubclass, a variableByteSubclass,
         a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
         c.f. typeOfClass"
        ^self isVariable
                ifTrue:
                        [self isBits
                                ifTrue:
                                        [self isBytes
                                                ifTrue: [' variableByteSubclass: ']
                                                ifFalse: [' variableWordSubclass: ']]
                                ifFalse:
                                        [self isWeak
                                                ifTrue: [' weakSubclass: ']
                                                ifFalse: [' variableSubclass: ']]]
                ifFalse:
                        [self isImmediateClass
                                ifTrue: [' immediateSubclass: ']
                                ifFalse:
                                        [self isEphemeronClass
                                                ifTrue: [' ephemeronSubclass: ']
                                                ifFalse: [' subclass: ']]]!

----- Method: SpurBootstrapPharoPrototypes>>VirtualMachinePROTOTYPEisSpur (in category 'method prototypes') -----
VirtualMachinePROTOTYPEisSpur
        "this value is always true but is here for backward compatibility (non Spur images should return false)"
        ^ true!

----- Method: SpurBootstrapPharoPrototypes>>VirtualMachinePROTOTYPEsetGCParameters (in category 'method prototypes') -----
VirtualMachinePROTOTYPEsetGCParameters
        "Adjust the VM's default GC parameters to avoid too much tenuring.
         Maybe this should be left to the VM?"

        | proportion edenSize survivorSize averageObjectSize numObjects |
        proportion := 0.9. "tenure when 90% of pastSpace is full"
        edenSize := self parameterAt: 44.
        survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
        averageObjectSize := 8 * self wordSize. "a good approximation"
        numObjects := (proportion * survivorSize / averageObjectSize) rounded.
        self tenuringThreshold: numObjects  "tenure when more than this many objects survive the GC"!

----- Method: SpurBootstrapPrototypes class>>allMethodPrototypes (in category 'accessing method dictionary') -----
allMethodPrototypes
        ^(self canUnderstand: #allMethods)
                ifTrue: "Pharo"
                        [self allMethods select:
                                [:each| each category = 'method prototypes']]
                ifFalse: "Squeak" "%$#@*!! collect: on IdentitySet answers a *Set*, not an IdentitySet %$#@*!!"
                        [(self allSelectors collect: [:s| self lookupSelector: s] as: IdentitySet)
                                select: [:m| m protocol = 'method prototypes']]!

----- Method: SpurBootstrapPrototypes class>>imageType (in category 'accessing') -----
imageType
        ^ self subclassResponsibility!

----- Method: SpurBootstrapPrototypes class>>prototypeClassFor: (in category 'instance creation') -----
prototypeClassFor: type
        | deepest |
        deepest := nil.
        self allSubclassesDo:
                [:aClass | aClass imageType = type ifTrue: [deepest := aClass]].
        ^deepest!

----- Method: SpurBootstrapPrototypes>>ArrayPROTOTYPEelementsExchangeIdentityWith: (in category 'method prototypes') -----
ArrayPROTOTYPEelementsExchangeIdentityWith: otherArray
        "This primitive performs a bulk mutation, causing all pointers to the elements of the
         receiver to be replaced by pointers to the corresponding elements of otherArray.
         At the same time, all pointers to the elements of otherArray are replaced by
         pointers to the corresponding elements of this array.  The identityHashes remain
         with the pointers rather than with the objects so that objects in hashed structures
         should still be properly indexed after the mutation."

        <primitive: 128 error: ec>
        ec == #'bad receiver' ifTrue:
                [^self error: 'receiver must be of class Array'].
        ec == #'bad argument' ifTrue:
                [^self error: (otherArray class == Array
                                                ifTrue: ['arg must be of class Array']
                                                ifFalse: ['receiver and argument must have the same size'])].
        ec == #'inappropriate operation' ifTrue:
                [^self error: 'can''t become immediates such as SmallIntegers or Characters'].
        ec == #'no modification' ifTrue:
                [^self error: 'can''t become immutable objects'].
        ec == #'object is pinned' ifTrue:
                [^self error: 'can''t become pinned objects'].
        ec == #'insufficient object memory' ifTrue:
                [Smalltalk garbageCollect < 1048576 ifTrue:
                        [Smalltalk growMemoryByAtLeast: 1048576].
                 ^self elementsExchangeIdentityWith: otherArray].
        self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>ArrayPROTOTYPEelementsForwardIdentityTo: (in category 'method prototypes') -----
ArrayPROTOTYPEelementsForwardIdentityTo: otherArray
        "This primitive performs a bulk mutation, causing all pointers to the elements of the
         receiver to be replaced by pointers to the corresponding elements of otherArray.
         The identityHashes remain with the pointers rather than with the objects so that
         the objects in this array should still be properly indexed in any existing hashed
         structures after the mutation."
        <primitive: 72 error: ec>
        ec == #'bad receiver' ifTrue:
                [^self error: 'receiver must be of class Array'].
        ec == #'bad argument' ifTrue:
                [^self error: (otherArray class == Array
                                                ifTrue: ['arg must be of class Array']
                                                ifFalse: ['receiver and argument must have the same size'])].
        ec == #'inappropriate operation' ifTrue:
                [^self error: 'can''t become immediates such as SmallIntegers or Characters'].
        ec == #'no modification' ifTrue:
                [^self error: 'can''t become immutable objects'].
        ec == #'object is pinned' ifTrue:
                [^self error: 'can''t become pinned objects'].
        ec == #'insufficient object memory' ifTrue:
                [Smalltalk garbageCollect < 1048576 ifTrue:
                        [Smalltalk growMemoryByAtLeast: 1048576].
                 ^self elementsForwardIdentityTo: otherArray].
        self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>ArrayPROTOTYPEelementsForwardIdentityTo:copyHash: (in category 'method prototypes') -----
ArrayPROTOTYPEelementsForwardIdentityTo: otherArray copyHash: copyHash
        "This primitive performs a bulk mutation, causing all pointers to the elements of the
         receiver to be replaced by pointers to the corresponding elements of otherArray.
         If copyHash is true, the identityHashes remain with the pointers rather than with the
         objects so that the objects in the receiver should still be properly indexed in any
         existing hashed structures after the mutation.  If copyHash is false, then the hashes
         of the objects in otherArray remain unchanged.  If you know what you're doing this
         may indeed be what you want."
        <primitive: 249 error: ec>
        ec == #'bad receiver' ifTrue:
                [^self error: 'receiver must be of class Array'].
        ec == #'bad argument' ifTrue:
                [^self error: (otherArray class == Array
                                                ifTrue: ['arg must be of class Array']
                                                ifFalse: ['receiver and argument must have the same size'])].
        ec == #'inappropriate operation' ifTrue:
                [^self error: 'can''t become immediates such as SmallIntegers or Characters'].
        ec == #'no modification' ifTrue:
                [^self error: 'can''t become immutable objects'].
        ec == #'object is pinned' ifTrue:
                [^self error: 'can''t become pinned objects'].
        ec == #'insufficient object memory' ifTrue:
                [Smalltalk garbageCollect < 1048576 ifTrue:
                        [Smalltalk growMemoryByAtLeast: 1048576].
                 ^self elementsForwardIdentityTo: otherArray copyHash: copyHash].
        self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
BehaviorPROTOTYPEallInstances
        "Answer all instances of the receiver."
        <primitive: 177>
        "The primitive can fail because memory is low.  If so, fall back on the old
         enumeration code, which gives the system a chance to GC and/or grow.
         Because aBlock might change the class of inst (for example, using become:),
         it is essential to compute next before aBlock value: inst."
        | inst insts next |
        insts := WriteStream on: (Array new: 64).
        inst := self someInstance.
        [inst == nil] whileFalse:
                [next := inst nextInstance.
                 (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
                 inst := next].
        ^insts contents!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
BehaviorPROTOTYPEallInstancesDo: aBlock
        "Evaluate aBlock with each of the current instances of the receiver."
        | instances inst next |
        instances := self allInstancesOrNil.
        instances ifNotNil:
                [instances do: aBlock.
                 ^self].
        "allInstancesOrNil can fail because memory is low.  If so, fall back on the old
         enumeration code.  Because aBlock might change the class of inst (for example,
         using become:), it is essential to compute next before aBlock value: inst."
        inst := self someInstance.
        [inst == nil] whileFalse:
                [next := inst nextInstance.
                 aBlock value: inst.
                 inst := next]!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstancesOrNil (in category 'method prototypes') -----
BehaviorPROTOTYPEallInstancesOrNil
        "Answer all instances of the receiver, or nil if the primitive
         fails, which it may be due to being out of memory."
        <primitive: 177>
        ^nil!

----- Method: SpurBootstrapPrototypes>>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 that space was low and retry
         via handleFailingBasicNew if so."

        <primitive: 70 error: ec>
        ec == #'insufficient object memory' ifTrue:
                [^self handleFailingBasicNew].
        self isVariable ifTrue: [^self basicNew: 0].
        self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>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."

        <primitive: 71 error: ec>
        ec == #'insufficient object memory' ifTrue:
                [^self handleFailingBasicNew: sizeRequested].
        self isVariable ifFalse:
                [self error: self printString, ' cannot have variable sized instances'].
        self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbyteSizeOfInstance (in category 'method prototypes') -----
BehaviorPROTOTYPEbyteSizeOfInstance
        "Answer the total memory size of an instance of the receiver."

        <primitive: 181 error: ec>
        self isVariable ifTrue:
                [^self byteSizeOfInstanceOfSize: 0].
        self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: (in category 'method prototypes') -----
BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: basicSize
        "Answer the total memory size of an instance of the receiver
         with the given number of indexable instance variables."

        <primitive: 181 error: ec>
        self isVariable
                ifTrue: "If the primitive overflowed answer a close approximation"
                        [(basicSize isInteger
                          and: [basicSize >= 16r1000000]) ifTrue:
                                [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
                                   - (self byteSizeOfInstanceOfSize: 0)]]
                ifFalse:
                        [basicSize = 0 ifTrue:
                                [^self byteSizeOfInstance]].
        self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>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)"
        | instSpec |
        instSpec := self instSpec.
        instSpec < 9 ifTrue: [^Smalltalk wordSize].
        instSpec >= 16 ifTrue: [^1].
        instSpec >= 12 ifTrue: [^2].
        instSpec >= 10 ifTrue: [^4].
        ^8!

----- Method: SpurBootstrapPrototypes>>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.

         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"!

----- Method: SpurBootstrapPrototypes>>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.

         Primitive. Answer an instance of this class with the number of indexable
         variables specified by the argument, sizeRequested.  Fail if this class is not
         indexable or if the argument is not a positive Integer, or if there is not
         enough memory available. Essential. See Object documentation whatIsAPrimitive."

        <primitive: 71>
        | bytesRequested |
        bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
        Smalltalk garbageCollect < bytesRequested ifTrue:
                [Smalltalk growMemoryByAtLeast: bytesRequested].
        "retry after global garbage collect and possible grow"
        ^self handleFailingFailingBasicNew: sizeRequested!

----- Method: SpurBootstrapPrototypes>>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.

         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"!

----- Method: SpurBootstrapPrototypes>>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.

         Primitive. Answer an instance of this class with the number of indexable
         variables specified by the argument, sizeRequested.  Fail if this class is not
         indexable or if the argument is not a positive Integer, or if there is not
         enough memory available. Essential. See Object documentation whatIsAPrimitive."

        <primitive: 71>
        "space must be low."
        OutOfMemory signal.
        ^self basicNew: sizeRequested  "retry if user proceeds"!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEindexIfCompact (in category 'method prototypes') -----
BehaviorPROTOTYPEindexIfCompact
        "Backward compatibility with the Squeak V3 object format.
         Spur does not have a distinction between compact and non-compact classes."
        ^0!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEinstSize (in category 'method prototypes') -----
BehaviorPROTOTYPEinstSize
        <indirect>!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
BehaviorPROTOTYPEinstSpec
        <indirect>!

----- Method: SpurBootstrapPrototypes>>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!

----- Method: SpurBootstrapPrototypes>>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)"
        ^self instSpec >= 16!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisCompiledMethodClass (in category 'method prototypes') -----
BehaviorPROTOTYPEisCompiledMethodClass
        "Answer whether the receiver has compiled method instances that mix pointers and bytes."
        ^self instSpec >= 24!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') -----
BehaviorPROTOTYPEisEphemeronClass
        "Answer whether the receiver has ephemeral instance variables.  The garbage collector will
         fire (queue for finalization) any ephemeron whose first instance variable is not referenced
         other than from the transitive closure of references from ephemerons. Hence referring to
         an object from the first inst var of an ephemeron will cause the ephemeron to fire when
         the rest of the system does not refer to the object and that object is ready to be collected.
         Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
         from firing, ephemerons may act as the associations in weak dictionaries such that the value
         (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
         other than from ephemerons.  Ephemerons can therefore be used to implement instance-based
         pre-mortem finalization."
        ^self instSpec = 5!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') -----
BehaviorPROTOTYPEisImmediateClass
        "Answer whether the receiver has immediate instances.  Immediate instances
         store their value in their object pointer, not in an object body.  Hence immediates
         take no space and are immutable.  The immediates are distinguished by tag bits
         in the pointer. They include SmallIntegers and Characters.  Hence in the 32-bit
         system SmallIntegers are 31-bit signed integers and Characters are 30-bit
         unsigned character codes."
        ^self instSpec = 7!

----- Method: SpurBootstrapPrototypes>>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)"
        | instSpec |
        instSpec := self instSpec.
        ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
BehaviorPROTOTYPEkindOfSubclass
        "Answer a String that is the keyword that describes the receiver's kind of subclass,
         either a regular subclass, a variableSubclass, a variableByteSubclass,
         a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
         c.f. typeOfClass"
        ^self isVariable
                ifTrue:
                        [self isBits
                                ifTrue:
                                        [self isBytes
                                                ifTrue: [' variableByteSubclass: ']
                                                ifFalse: [' variableWordSubclass: ']]
                                ifFalse:
                                        [self isWeak
                                                ifTrue: [' weakSubclass: ']
                                                ifFalse: [' variableSubclass: ']]]
                ifFalse:
                        [self isImmediateClass
                                ifTrue: [' immediateSubclass: ']
                                ifFalse:
                                        [self isEphemeronClass
                                                ifTrue: [' ephemeronSubclass: ']
                                                ifFalse: [' subclass: ']]]!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEshouldNotBeRedefined (in category 'method prototypes') -----
BehaviorPROTOTYPEshouldNotBeRedefined
        "Answer if the receiver should not be redefined.
         The assumption is that classes in Smalltalk specialObjects and
         instance-specific Behaviors should not be redefined"

        ^(Smalltalk specialObjectsArray
                identityIndexOf: self
                ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!

----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEtypeOfClass (in category 'method prototypes') -----
BehaviorPROTOTYPEtypeOfClass
        "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass"
        self isBytes ifTrue:
                [^self instSpec = CompiledMethod instSpec
                        ifTrue: [#compiledMethod] "Very special!!"
                        ifFalse: [#bytes]].
        (self isWords and: [self isPointers not]) ifTrue:
                [^self instSpec = SmallInteger instSpec
                        ifTrue: [#immediate] "Very special!!"
                        ifFalse: [#words]].
        self isWeak ifTrue: [^#weak].
        self isVariable ifTrue: [^#variable].
        self isEphemeronClass ifTrue: [^#ephemeron].
        ^#normal!

----- Method: SpurBootstrapPrototypes>>BoxedFloat64classPROTOTYPEbasicNew (in category 'method prototypes') -----
BoxedFloat64classPROTOTYPEbasicNew
        ^self basicNew: 2!

----- Method: SpurBootstrapPrototypes>>BoxedFloat64classPROTOTYPEbasicNew: (in category 'method prototypes') -----
BoxedFloat64classPROTOTYPEbasicNew: sizeRequested
        "Primitive. Answer an instance of this class with the number
         of indexable variables specified by the argument, sizeRequested.
         Fail if this class is not indexable or if the argument is not a
         positive Integer, or if there is not enough memory available.
         Essential. See Object documentation whatIsAPrimitive."

        <primitive: 71>
        sizeRequested isInteger ifTrue:
                [^sizeRequested = 2
                        ifTrue: "arg okay; space must be low."
                                [OutOfMemory signal.
                                 self basicNew: sizeRequested]  "retry if user proceeds"
                        ifFalse:
                                [self error: 'a Float shall always have two slots']].
        self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
        numArgs > 15 ifTrue:
                [^self error: 'Cannot compile -- too many arguments'].
        numTemps > 63 ifTrue:
                [^self error: 'Cannot compile -- too many temporary variables'].
        numLits > 65535 ifTrue:
                [^self error: 'Cannot compile -- too many literals'].
        ^(CompiledMethod headerFlagForEncoder: self)
        + (numArgs bitShift: 24)
        + (numTemps bitShift: 18)
        "+ (largeBit bitShift: 17)" "largeBit gets filled in later"
        + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
        + numLits!

----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEsizeCallPrimitive: (in category 'method prototypes') -----
BytecodeEncoderPROTOTYPEsizeCallPrimitive: primitiveIndex
        ^self sizeOpcodeSelector: #genCallPrimitive: withArguments: {primitiveIndex}!

----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEDollarEquals: (in category 'method prototypes') -----
CharacterPROTOTYPEDollarEquals: aCharacter
        "Primitive. Answer if the receiver and the argument are the
         same object (have the same object pointer). Optional. See
         Object documentation whatIsAPrimitive."
        <primitive: 110>
        ^self == aCharacter!

----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasInteger (in category 'method prototypes') -----
CharacterPROTOTYPEasInteger
        "Answer the receiver's character code."
        <primitive: 171>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasciiValue (in category 'method prototypes') -----
CharacterPROTOTYPEasciiValue
        "Answer the receiver's character code.
         This will be ascii for characters with value <= 127,
         and Unicode for those with higher values."
        <primitive: 171>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEcomeFullyUpOnReload: (in category 'method prototypes') -----
CharacterPROTOTYPEcomeFullyUpOnReload: smartRefStream
        "Now Characters are immediates, this can be deleted."
        <remove>!

----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEcopy (in category 'method prototypes') -----
CharacterPROTOTYPEcopy
        "Answer the receiver, because Characters are unique."
        ^self!

----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEdeepCopy (in category 'method prototypes') -----
CharacterPROTOTYPEdeepCopy
        "Answer the receiver, because Characters are unique."
        ^self!

----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEhash (in category 'method prototypes') -----
CharacterPROTOTYPEhash
        "Hash is reimplemented because = is implemented.
         Answer the receiver's character code."
        <primitive: 171>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEidentityHash (in category 'method prototypes') -----
CharacterPROTOTYPEidentityHash
        "Answer the receiver's character code."
        <primitive: 171>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
CharacterPROTOTYPEshallowCopy
        "Answer the receiver, because Characters are unique."
        ^self!

----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
CharacterPROTOTYPEveryDeepCopyWith: deepCopier
        "Answer the receiver, because Characters are unique."
        ^self!

----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEdigitValue: (in category 'method prototypes') -----
CharacterclassPROTOTYPEdigitValue: x
        "Answer the Character whose digit value is x. For example,
         answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35."

        | n |
        n := x asInteger.
        ^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])!

----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
CharacterclassPROTOTYPEinitialize
        "Create the DigitsValues table."
        "Character initialize"
        self initializeDigitValues!

----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEvalue: (in category 'method prototypes') -----
CharacterclassPROTOTYPEvalue: anInteger
        "Answer the Character whose value is anInteger."
        <primitive: 170>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>ClassDescriptionPROTOTYPEupdateInstances:from:isMeta: (in category 'method prototypes') -----
ClassDescriptionPROTOTYPEupdateInstances: oldInstances from: oldClass isMeta: isMeta
        "Recreate any existing instances of the argument, oldClass, as instances of the receiver,
         which is a newly changed class. Permute variables as necessary, and forward old instances
         to new instances.  Answer nil to defeat old clients that expect an array of old instances.
         The old behaviour, which necessitated a global GC, exchanged identities and answered
         the old instances.  But no clients used the result.  This way we avoid the unnecessary GC,"
        | map variable instSize newInstances |

        oldInstances isEmpty ifTrue:
                [^nil]. "no instances to convert"
        isMeta ifTrue:
                [(oldInstances size = 1
                  and: [self soleInstance class == self
                                or: [self soleInstance class == oldClass]]) ifFalse:
                        [^self error: 'Metaclasses can only have one instance']].
        map := self instVarMappingFrom: oldClass.
        variable := self isVariable.
        instSize := self instSize.
        newInstances := Array new: oldInstances size.
        1 to: oldInstances size do:
                [:i|
                newInstances
                        at: i
                        put: (self newInstanceFrom: (oldInstances at: i) variable: variable size: instSize map: map)].
        "Now perform a bulk mutation of old instances into new ones"
        oldInstances elementsForwardIdentityTo: newInstances.
        ^nil!

----- Method: SpurBootstrapPrototypes>>ClassDescriptionPROTOTYPEupdateInstancesFrom: (in category 'method prototypes') -----
ClassDescriptionPROTOTYPEupdateInstancesFrom: oldClass
        "Recreate any existing instances of the argument, oldClass, as instances of
         the receiver, which is a newly changed class. Permute variables as necessary,
         and forward old instances to new instances.. Answer nil to defeat any clients
         that expected the old behaviour of answering the array of old instances."
        "ar 7/15/1999: The updating below is possibly dangerous. If there are any
        contexts having an old instance as receiver it might crash the system if
        the new receiver in which the context is executed has a different layout.
        See bottom below for a simple example:"
        self updateInstances: oldClass allInstances asArray from: oldClass isMeta: self isMeta.
        "Now fix up instances in segments that are out on the disk."
        ImageSegment allSubInstancesDo:
                [:seg |
                seg segUpdateInstancesOf: oldClass toBe: self isMeta: self isMeta].
        ^nil

"This attempts to crash the VM by stepping off the end of an instance.
 As the doctor says, do not do this."
" | crashingBlock class |
        class := Object subclass: #CrashTestDummy
                instanceVariableNames: 'instVar'
                classVariableNames: ''
                poolDictionaries: ''
                category: 'Crash-Test'.
        class compile:'instVar: value instVar := value'.
        class compile:'crashingBlock ^[instVar]'.
        crashingBlock := (class new) instVar: 42; crashingBlock.
        Object subclass: #CrashTestDummy
                instanceVariableNames: ''
                classVariableNames: ''
                poolDictionaries: ''
                category: 'Crash-Test'.
        crashingBlock value"!

----- Method: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEnumLiterals (in category 'method prototypes') -----
CompiledMethodPROTOTYPEnumLiterals
        "Answer the number of literals used by the receiver."
        ^self header bitAnd: 16r7FFF!

----- Method: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEprimitive (in category 'method prototypes') -----
CompiledMethodPROTOTYPEprimitive
        "Answer the primitive index associated with the receiver.
         Zero indicates that this is not a primitive method."
        | initialPC |
        ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
                ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
                ifFalse: [0]!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod:header: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod: numberOfBytes header: headerWord
        "This newMethod:header: gets sent after handleFailingBasicNew: has done a full
         garbage collection and possibly grown memory.  If this basicNew: fails then the
         system really is low on space, so raise the OutOfMemory signal.

         Primitive. Answer an instance of this class with the number of indexable variables
         specified by the argument, headerWord, and the number of bytecodes specified
         by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
         is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
         memory available. Essential. See Object documentation whatIsAPrimitive."

        <primitive: 79>
        "space must be low."
        OutOfMemory signal.
        "retry if user proceeds"
        ^self newMethod: numberOfBytes header: headerWord!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEhandleFailingNewMethod:header: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEhandleFailingNewMethod: numberOfBytes header: headerWord
        "This newMethod:header: gets sent after newMethod:header: has failed
         and allowed a scavenging garbage collection to occur.  The scavenging
         collection will have happened as the VM is activating the (failing) basicNew:.
         If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
         space and a global garbage collection is required.  Retry after garbage
         collecting and growing memory if necessary.

         Primitive. Answer an instance of this class with the number of indexable variables
         specified by the argument, headerWord, and the number of bytecodes specified
         by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
         is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
         memory available. Essential. See Object documentation whatIsAPrimitive."

        <primitive: 79>
        | bytesRequested |
        bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16.
        Smalltalk garbageCollect < bytesRequested ifTrue:
                [Smalltalk growMemoryByAtLeast: bytesRequested].
        "retry after global garbage collect and possible grow"
        ^self handleFailingFailingNewMethod: numberOfBytes header: headerWord!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
        <indirect>!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinitialize (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEinitialize    "CompiledMethod initialize"
        <indirect>!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
        <indirect>!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: aBytecodeEncoderSubclass
        <indirect>!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
        "Since this method refers to ClassVariables things are easier if it lives in the actual class."

        <indirect>!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
        "Since this method refers to ClassVariables things are easier if it lives in the actual class."

        <indirect>!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewMethod:header: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEnewMethod: numberOfBytes header: headerWord
        "Primitive. Answer an instance of me. The number of literals (and other
         information) is specified by the headerWord (see my class comment).
         The first argument specifies the number of fields for bytecodes in the
         method. Fail if either argument is not a SmallInteger, or if numberOfBytes
         is negative, or if memory is low. Once the header of a method is set by
         this primitive, it cannot be changed to change the number of literals.
         Essential. See Object documentation whatIsAPrimitive."

        <primitive: 79 error: ec>
        ec == #'insufficient object memory' ifTrue:
                [^self handleFailingNewMethod: numberOfBytes header: headerWord].
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnConstant:trailerBytes: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEtoReturnConstant: index trailerBytes: trailer
        "Answer an instance of me that is a quick return of the constant
        indexed in (true false nil -1 0 1 2)."

        ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnField:trailerBytes: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEtoReturnField: field trailerBytes: trailer
        "Answer an instance of me that is a quick return of the instance variable
        indexed by the argument, field."

        ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!

----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: (in category 'method prototypes') -----
CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: trailer
        "Answer an instance of me that is a quick return of the instance (^self)."

        ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!

----- Method: SpurBootstrapPrototypes>>EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
        <remove>!

----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: (in category 'method prototypes') -----
EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: primitiveIndex
        "Since this method has inst var refs the prototype must live in the actual class."

        <indirect>!

----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: (in category 'method prototypes') -----
EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: bytecode
        "Answer the number of bytes in the bytecode."
        bytecode <= 125 ifTrue:
                [^1].
        bytecode >= 176 ifTrue:
                [^1].
        bytecode >= 160 ifTrue: "long jumps"
                [^2].
        bytecode >= 144 ifTrue: "short jumps"
                [^1].
        "extensions"
        bytecode >= 128 ifTrue:
                [^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127].
        ^nil!

----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode (in category 'method prototypes') -----
EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode
        "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
        ^139!

----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEbasicNew (in category 'method prototypes') -----
FloatclassPROTOTYPEbasicNew
        ^BoxedFloat64 basicNew: 2!

----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEbasicNew: (in category 'method prototypes') -----
FloatclassPROTOTYPEbasicNew: anInteger
        ^BoxedFloat64 basicNew: 2!

----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEfromIEEE32Bit: (in category 'method prototypes') -----
FloatclassPROTOTYPEfromIEEE32Bit: word
        "Convert the given 32 bit word (which is supposed to be a positive 32-bit value) from
         a 32 bit IEEE floating point representation into an actual Squeak float object (being
         64 bits wide). Should only be used for conversion in FloatArrays or likewise objects."
       
        | sign mantissa exponent delta |
        word <= 0 ifTrue:
                [^word negative
                        ifTrue: [self error: 'Cannot deal with negative numbers']
                        ifFalse: [self zero]].
        sign := word bitAnd: 16r80000000.
        word = sign ifTrue:
                [^self negativeZero].
       
        exponent := ((word bitShift: -23) bitAnd: 16rFF) - 127.
        mantissa := word bitAnd:  16r7FFFFF.

        exponent = 128 ifTrue: "Either NAN or INF"
                [^mantissa = 0
                        ifTrue:
                                [sign = 0
                                        ifTrue: [self infinity]
                                        ifFalse: [self negativeInfinity]]
                        ifFalse: [self nan]].

        exponent = -127 ifTrue:
                "gradual underflow (denormalized number)
                 Remove first bit of mantissa and adjust exponent"
                [delta := mantissa highBit.
                 mantissa := (mantissa bitAnd: (1 bitShift: delta - 1) - 1) bitShift: 24 - delta.
                 exponent := exponent + delta - 23].
       
        "Create new float"
        ^(self basicNew: 2)
                basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3));
                basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29);
                * 1.0 "reduce to SmallFloat64 if possible"!

----- Method: SpurBootstrapPrototypes>>InstructionClientPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
InstructionClientPROTOTYPEcallPrimitive: pimIndex
        "V3PlusClosures: 139 10001011 iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
         NewsqueakV4: 249 11111001 iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
         SistaV1: 248 11111000 iiiiiiii mjjjjjjj  Call Primitive #iiiiiiii + ( jjjjjjj * 256)
                                                        m=1 means inlined primitive, no hard return after execution."!

----- Method: SpurBootstrapPrototypes>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category 'method prototypes') -----
InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client
        "Since this method has inst var refs the prototype must live in the actual class."

        <indirect>!

----- Method: SpurBootstrapPrototypes>>LargeNegativeIntegerPROTOTYPEnormalize (in category 'method prototypes') -----
LargeNegativeIntegerPROTOTYPEnormalize
        "Check for leading zeroes and return shortened copy if so"
        | sLen val len oldLen minVal |
        <primitive: 'primNormalizeNegative' module: 'LargeIntegers'>
        "First establish len = significant length"
        len := oldLen := self digitLength.
        [len = 0 ifTrue: [^0].
        (self digitAt: len) = 0]
                whileTrue: [len := len - 1].

        "Now check if in SmallInteger range.
         Fast compute SmallInteger minVal digitLength"
        sLen := SmallInteger minVal < -16r40000000
                                ifTrue: [8]
                                ifFalse: [4].
        len <= sLen ifTrue:
                [minVal := SmallInteger minVal.
                (len < sLen
                 or: [(self digitAt: sLen) < minVal lastDigit])
                        ifTrue: ["If high digit less, then can be small"
                                        val := 0.
                                        len to: 1 by: -1 do:
                                                [:i | val := (val *256) - (self digitAt: i)].
                                        ^ val].
                1 to: sLen do:  "If all digits same, then = minVal"
                        [:i | (self digitAt: i) = (minVal digitAt: i)
                                        ifFalse: ["Not so; return self shortened"
                                                        len < oldLen
                                                                ifTrue: [^ self growto: len]
                                                                ifFalse: [^ self]]].
                ^ minVal].

        "Return self, or a shortened copy"
        len < oldLen
                ifTrue: [^ self growto: len]
                ifFalse: [^ self]!

----- Method: SpurBootstrapPrototypes>>LargePositiveIntegerPROTOTYPEnormalize (in category 'method prototypes') -----
LargePositiveIntegerPROTOTYPEnormalize
        "Check for leading zeroes and return shortened copy if so"
        | sLen val len oldLen |
        <primitive: 'primNormalizePositive' module:'LargeIntegers'>
        "First establish len = significant length"
        len := oldLen := self digitLength.
        [len = 0 ifTrue: [^0].
        (self digitAt: len) = 0]
                whileTrue: [len := len - 1].

        "Now check if in SmallInteger range.  Fast compute SmallInteger maxVal digitLength"
        sLen := SmallInteger maxVal > 16r3FFFFFFF
                                ifTrue: [8]
                                ifFalse: [4].
        (len <= sLen
         and: [(self digitAt: sLen) <= (SmallInteger maxVal digitAt: sLen)])
                ifTrue: ["If so, return its SmallInt value"
                                val := 0.
                                len to: 1 by: -1 do:
                                        [:i | val := (val *256) + (self digitAt: i)].
                                ^ val].

        "Return self, or a shortened copy"
        len < oldLen
                ifTrue: [^ self growto: len]
                ifFalse: [^ self]!

----- Method: SpurBootstrapPrototypes>>MethodNodeOLDSQUEAKPROTOTYPEgenerate: (in category 'method prototypes') -----
MethodNodeOLDSQUEAKPROTOTYPEgenerate: trailer
        "The receiver is the root of a parse tree. Answer a CompiledMethod.
         The argument, trailer, is arbitrary but is typically either the reference
         to the source code that is stored with every CompiledMethod, or an
         encoding of the method's temporary names."

        ^self generate: trailer using: CompiledMethod!

----- Method: SpurBootstrapPrototypes>>MethodNodePROTOTYPEgenerate:using: (in category 'method prototypes') -----
MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass
        "Since this method has inst var refs the prototype must live in the actual class."

        <indirect>!

----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEclone (in category 'method prototypes') -----
ObjectPROTOTYPEclone
        "Answer a shallow copy of the receiver."
        <primitive: 148 error: ec>
        | class newObject |
        ec == #'insufficient object memory' ifFalse:
                [^self primitiveFailed].
        "If the primitive fails due to insufficient memory, instantiate via basicNew: to invoke
         the garbage collector before retrying, and use copyFrom: to copy state."
        newObject := (class := self class) isVariable
                                        ifTrue:
                                                [class isCompiledMethodClass
                                                        ifTrue:
                                                                [class newMethod: self basicSize - self initialPC + 1 header: self header]
                                                        ifFalse:
                                                                [class basicNew: self basicSize]]
                                        ifFalse:
                                                [class basicNew].
        ^newObject copyFrom: self!

----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEinstVarAt: (in category 'method prototypes') -----
ObjectPROTOTYPEinstVarAt: index
        "Primitive. Answer a fixed variable in an object. The numbering of the variables
         corresponds to the named instance variables, followed by the indexed instance
         variables. Fail if the index is not an Integer or is not the index of a fixed variable.
         Essential. See Object documentation whatIsAPrimitive."

        <primitive: 173 error: ec>
        self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEinstVarAt:put: (in category 'method prototypes') -----
ObjectPROTOTYPEinstVarAt: index put: anObject
        "Primitive. Store a value into a fixed variable in an object. The numbering of the
         variables corresponds to the named instance variables, followed by the indexed
         instance variables. Fail if the index is not an Integer or is not the index of a fixed
         variable. Essential. See Object documentation whatIsAPrimitive."

        <primitive: 174 error: ec>
        self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEisPinned (in category 'method prototypes') -----
ObjectPROTOTYPEisPinned
        "Answer if the receiver is pinned.  The VM's garbage collector routinely moves
         objects as it reclaims and compacts memory.  But it can also pin an object so
         that it will not be moved, which can make it easier to pass objects out through
         the FFI."
        <primitive: 183 error: ec>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEoopAge (in category 'method prototypes') -----
ObjectPROTOTYPEoopAge
        <remove>!

----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEoopTimestamp (in category 'method prototypes') -----
ObjectPROTOTYPEoopTimestamp
        <remove>!

----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEpin (in category 'method prototypes') -----
ObjectPROTOTYPEpin
        "The VM's garbage collector routinely moves objects as it reclaims and compacts
         memory. But it can also pin an object so that it will not be moved, which can make
         it easier to pass objects out through the FFI.  Objects are unpinnned when created.
         This method ensures an object is pinned, and answers whether it was already pinned."
        ^self setPinned: true!

----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEsetPinned: (in category 'method prototypes') -----
ObjectPROTOTYPEsetPinned: aBoolean
        "The VM's garbage collector routinely moves objects as it reclaims and compacts
         memory. But it can also pin an object so that it will not be moved, which can make
         it easier to pass objects out through the FFI.  Objects are unpinnned when created.
         This primitive either pins or unpins an object, and answers if it was already pinned."
        <primitive: 184 error: ec>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>ObjectPROTOTYPEunpin (in category 'method prototypes') -----
ObjectPROTOTYPEunpin
        "The VM's garbage collector routinely moves objects as it reclaims and compacts
         memory. But it can also pin an object so that it will not be moved, which can make
         it easier to pass objects out through the FFI.  Objects are unpinnned when created.
         This method ensures an object is unpinned, and answers whether it was pinned."
        ^self setPinned: false!

----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEclone (in category 'method prototypes') -----
SmallFloat64PROTOTYPEclone
        "Answer the receiver, because SmallFloat64s are unique."
        ^self!

----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEcopy (in category 'method prototypes') -----
SmallFloat64PROTOTYPEcopy
        "Answer the receiver, because SmallFloat64s are unique."
        ^self!

----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEdeepCopy (in category 'method prototypes') -----
SmallFloat64PROTOTYPEdeepCopy
        "Answer the receiver, because SmallFloat64s are unique."
        ^self!

----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEidentityHash (in category 'method prototypes') -----
SmallFloat64PROTOTYPEidentityHash
        "Answer an integer unique to the receiver."
        <primitive: 171>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEshallowCopy (in category 'method prototypes') -----
SmallFloat64PROTOTYPEshallowCopy
        "Answer the receiver, because SmallFloat64s are unique."
        ^self!

----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
SmallFloat64PROTOTYPEveryDeepCopyWith: deepCopier
        "Answer the receiver, because SmallFloat64s are unique."
        ^self!

----- Method: SpurBootstrapPrototypes>>SmallFloat64classPROTOTYPEbasicNew (in category 'method prototypes') -----
SmallFloat64classPROTOTYPEbasicNew
        self error: 'SmallFloat64s can only be created by performing arithmetic'!

----- Method: SpurBootstrapPrototypes>>SmallFloat64classPROTOTYPEbasicNew: (in category 'method prototypes') -----
SmallFloat64classPROTOTYPEbasicNew: anInteger
        ^self basicNew!

----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEasCharacter (in category 'method prototypes') -----
SmallIntegerPROTOTYPEasCharacter
        <primitive: 170>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEdecimalDigitLength (in category 'method prototypes') -----
SmallIntegerPROTOTYPEdecimalDigitLength
        "Answer the number of digits printed out in base 10.
         Note that this only works for positive SmallIntegers up to 64-bits."
       
        ^self < 10000
                ifTrue:
                        [self < 100
                                ifTrue:
                                        [self < 10 ifTrue: [1] ifFalse: [2]]
                                ifFalse:
                                        [self < 1000 ifTrue: [3] ifFalse: [4]]]
                ifFalse:
                        [self < 100000000
                                ifTrue:
                                        [self < 1000000
                                                ifTrue: [self < 100000 ifTrue: [5] ifFalse: [6]]
                                                ifFalse: [self < 10000000 ifTrue: [7] ifFalse: [8]]]
                                ifFalse:
                                        [self < 1000000000000
                                                ifTrue:
                                                        [self < 10000000000
                                                                ifTrue: [self < 1000000000 ifTrue: [9] ifFalse: [10]]
                                                                ifFalse: [self < 100000000000 ifTrue: [11] ifFalse: [12]]]
                                                ifFalse:
                                                        [self < 10000000000000000
                                                                ifTrue:
                                                                        [self < 100000000000000
                                                                                ifTrue: [self < 10000000000000 ifTrue: [13] ifFalse: [14]]
                                                                                ifFalse: [self < 1000000000000000 ifTrue: [15] ifFalse: [16]]]
                                                                ifFalse:
                                                                        [self < 1000000000000000000
                                                                                ifTrue: [self < 100000000000000000 ifTrue: [17] ifFalse: [18]]
                                                                                ifFalse: [self < 10000000000000000000 ifTrue: [19] ifFalse: [20]]]]]]!

----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEdigitLength (in category 'method prototypes') -----
SmallIntegerPROTOTYPEdigitLength
        "Answer the number of indexable fields in the receiver. This value is the
         same as the largest legal subscript. Included so that a SmallInteger can
         behave like a LargePositiveInteger or LargeNegativeInteger."

        | value length |
        length := 1.
        value := self.
        value >= 0
                ifTrue:
                        [[value > 255] whileTrue:
                                [value := value bitShift: -8.
                                 length := length + 1]]
                ifFalse:
                        [[value < -255] whileTrue:
                                [value := value bitShift: -8.
                                 length := length + 1]].
        ^length!

----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEcompactClassesArray (in category 'method prototypes') -----
SmalltalkImagePROTOTYPEcompactClassesArray
        "Smalltalk compactClassesArray"
        "Backward-compatibility support.  Spur does not have compact classes."
        ^{}!

----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: numBytes
        "Grow memory by at least the requested number of bytes.
         Primitive.  Essential. Fail if no memory is available."
        <primitive: 180>
        (numBytes isInteger and: [numBytes > 0]) ifTrue:
                [OutOfMemory signal].
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
SmalltalkImagePROTOTYPEmaxIdentityHash
        "Answer the maximum identityHash value supported by the VM."
        <primitive: 176>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEprimBytesLeft (in category 'method prototypes') -----
SmalltalkImagePROTOTYPEprimBytesLeft
        "Primitive. Answer the number of free bytes available in old space.
         Not accurate unless preceded by
                Smalltalk garbageCollectMost (for reasonable accuracy), or
                Smalltalk garbageCollect (for real accuracy).
         See Object documentation whatIsAPrimitive."

        <primitive: 112>
        ^0!

----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEprimitiveGarbageCollect (in category 'method prototypes') -----
SmalltalkImagePROTOTYPEprimitiveGarbageCollect
        "Primitive. Reclaims all garbage and answers the size of the largest free chunk in old space.."

        <primitive: 130>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>SpaceTallyPROTOTYPEspaceForInstancesOf: (in category 'method prototypes') -----
SpaceTallyPROTOTYPEspaceForInstancesOf: aClass
        "Answer a pair of the number of bytes consumed by all instances of the
         given class, including their object headers, and the number of instances."

        | instances total |
        instances := aClass allInstances.
        instances isEmpty ifTrue: [^#(0 0)].
        total := 0.
        aClass isVariable
                ifTrue:
                        [instances do:
                                [:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]]
                ifFalse:
                        [total := instances size * aClass byteSizeOfInstance].
        ^{ total. instances size }!

----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: numBytes
        "Grow memory by at least the requested number of bytes.
         Primitive.  Fail if no memory is available.  Essential."
        <primitive: 180>
        ^(numBytes isInteger and: [numBytes > 0])
                ifTrue: [OutOfMemory signal]
                ifFalse: [self primitiveFailed]!

----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
SystemDictionaryPROTOTYPEmaxIdentityHash
        "Answer the maximum identityHash value supported by the VM."
        <primitive: 176>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjects (in category 'method prototypes') -----
SystemNavigationPROTOTYPEallObjects
        "Answer an Array of all objects in the system.  Fail if
         there isn't enough memory to instantiate the result."
        <primitive: 178>
        ^self primitiveFailed!

----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjectsDo: (in category 'method prototypes') -----
SystemNavigationPROTOTYPEallObjectsDo: aBlock
        "Evaluate the argument, aBlock, for each object in the system, excluding immediates
         such as SmallInteger and Character."
        self allObjectsOrNil
                ifNotNil: [:allObjects| allObjects do: aBlock]
                ifNil:
                        ["Fall back on the old single object primitive code.  With closures, this needs
                          to use an end marker (lastObject) since activation of the block will create
                          new contexts and cause an infinite loop.  The lastObject must be created
                          before calling someObject, so that the VM can settle the enumeration (e.g.
                          by flushing new space) as a side effect of  someObject"
                        | object lastObject |
                        lastObject := Object new.
                        object := self someObject.
                        [lastObject == object or: [0 == object]] whileFalse:
                                [aBlock value: object.
                                 object := object nextObject]]!

----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjectsOrNil (in category 'method prototypes') -----
SystemNavigationPROTOTYPEallObjectsOrNil
        "Answer an Array of all objects in the system.  Fail if there isn't
         enough memory to instantiate the result and answer nil."
        <primitive: 178>
        ^nil!

----- Method: SpurBootstrapPrototypes>>WideStringPROTOTYPEat: (in category 'method prototypes') -----
WideStringPROTOTYPEat: index
        "Answer the Character stored in the field of the receiver indexed by the
         argument.  Primitive.  Fail if the index argument is not an Integer or is out
         of bounds.  Essential.  See Object documentation whatIsAPrimitive."

        <primitive: 63>
        ^index isInteger
                ifTrue:
                        [self errorSubscriptBounds: index]
                ifFalse:
                        [index isNumber
                                ifTrue: [self at: index asInteger]
                                ifFalse: [self errorNonIntegerIndex]]!

----- Method: SpurBootstrapPrototypes>>WideStringPROTOTYPEat:put: (in category 'method prototypes') -----
WideStringPROTOTYPEat: index put: aCharacter
        "Store the Character into the field of the receiver indicated by the index.
         Primitive.  Fail if the index is not an Integer or is out of bounds, or if the
         argument is not a Character.  Essential.  See Object documentation whatIsAPrimitive."

        <primitive: 64>
        ^aCharacter isCharacter
                ifTrue:
                        [index isInteger
                                ifTrue: [self errorSubscriptBounds: index]
                                ifFalse: [self errorNonIntegerIndex]]
                ifFalse:
                        [self errorImproperStore]!

SpurBootstrapPrototypes subclass: #SpurBootstrapSqueakFamilyPrototypes
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Bootstrapping'!

SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapCuisPrototypes
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Bootstrapping'!

----- Method: SpurBootstrapCuisPrototypes class>>imageType (in category 'accessing') -----
imageType
        ^ 'cuis'!

----- Method: SpurBootstrapCuisPrototypes>>ArrayPROTOTYPEcreateMethod:class:header: (in category 'method prototypes') -----
ArrayPROTOTYPEcreateMethod: numberOfBytesForAllButTrailer class: aCompiledMethodClass header: headerWord
        | meth delta |
        meth := aCompiledMethodClass newMethod: numberOfBytesForAllButTrailer + self size header: headerWord.
        "copy the trailer data"
        delta := meth size - self size.
        1 to: self size do:
                [:i | meth at: delta + i put: (self at: i)].
        ^meth!

----- Method: SpurBootstrapCuisPrototypes>>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.

         Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."

        <primitive: 175>
        self primitiveFailed!

----- Method: SpurBootstrapCuisPrototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
        <indirect>!

----- Method: SpurBootstrapCuisPrototypes>>CharacterPROTOTYPEclone (in category 'method prototypes') -----
CharacterPROTOTYPEclone
        "Answer the receiver, because Characters are unique."
        ^self!

----- Method: SpurBootstrapCuisPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
CharacterPROTOTYPEsetValue: v
        <remove>!

----- Method: SpurBootstrapCuisPrototypes>>CharacterPROTOTYPEvalue (in category 'method prototypes') -----
CharacterPROTOTYPEvalue
        "Answer the value of the receiver that represents its ISO 8859-15 (Latin-9) encoding."
        <primitive: 171>
        ^self primitiveFailed!

----- Method: SpurBootstrapCuisPrototypes>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
CharacterclassPROTOTYPEinitialize
        <ignore>!

----- Method: SpurBootstrapCuisPrototypes>>ClassDescriptionPROTOTYPEupdateInstancesFrom: (in category 'method prototypes') -----
ClassDescriptionPROTOTYPEupdateInstancesFrom: oldClass
        "Recreate any existing instances of the argument, oldClass, as instances of
         the receiver, which is a newly changed class. Permute variables as necessary,
         and forward old instances to new instances.. Answer nil to defeat any clients
         that expected the old behaviour of answering the array of old instances."
        "ar 7/15/1999: The updating below is possibly dangerous. If there are any
        contexts having an old instance as receiver it might crash the system if
        the new receiver in which the context is executed has a different layout.
        See bottom below for a simple example:"
        self updateInstances: oldClass allInstances asArray from: oldClass isMeta: self isMeta.
        ^nil

"This attempts to crash the VM by stepping off the end of an instance.
 As the doctor says, do not do this."
" | crashingBlock class |
        class := Object subclass: #CrashTestDummy
                instanceVariableNames: 'instVar'
                classVariableNames: ''
                poolDictionaries: ''
                category: 'Crash-Test'.
        class compile:'instVar: value instVar := value'.
        class compile:'crashingBlock ^[instVar]'.
        crashingBlock := (class new) instVar: 42; crashingBlock.
        Object subclass: #CrashTestDummy
                instanceVariableNames: ''
                classVariableNames: ''
                poolDictionaries: ''
                category: 'Crash-Test'.
        crashingBlock value"!

----- Method: SpurBootstrapCuisPrototypes>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category 'method prototypes') -----
ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
        <indirect>!

----- Method: SpurBootstrapCuisPrototypes>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
ClassPROTOTYPEimmediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
        "This is the standard initialization message for creating a new
         immediate class as a subclass of an existing class (the receiver)."
        ^ClassBuilder new
                superclass: self
                immediateSubclass: t
                instanceVariableNames: f
                classVariableNames: d
                poolDictionaries: s
                category: cat!

----- Method: SpurBootstrapCuisPrototypes>>CompiledMethodPROTOTYPEbytecodeSetName (in category 'method prototypes') -----
CompiledMethodPROTOTYPEbytecodeSetName
        ^self encoderClass name copyReplaceAll: 'EncoderFor' with: ''!

----- Method: SpurBootstrapCuisPrototypes>>CompiledMethodPROTOTYPEheaderDescription (in category 'method prototypes') -----
CompiledMethodPROTOTYPEheaderDescription
        "Answer a description containing the information about the form of the
         receiver and the form of the context needed to run the receiver."

        ^(String new: 128) writeStream
                print: self header; cr;
                nextPutAll: '"primitive: '; print: self primitive; cr;
                nextPutAll: ' numArgs: '; print: self numArgs; cr;
                nextPutAll: ' numTemps: '; print: self numTemps; cr;
                nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
                nextPutAll: ' frameSize: '; print: self frameSize; cr;
                nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
                nextPut: $"; cr;
                contents!

----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEactivateReturn:value: (in category 'method prototypes') -----
ContextPartPROTOTYPEactivateReturn: aContext value: value
        "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"

        ^MethodContext
                sender: self
                receiver: aContext
                method: MethodContext theReturnMethod
                arguments: {value}!

----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
        "Simulate a primitive method whose index is primitiveIndex.  The simulated receiver and
         arguments are given as arguments to this message. If successful, push result and return
         resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
         execution needs to be intercepted and simulated to avoid execution running away."

        | value |
        "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
         the debugger from entering various run-away activities such as spawning a new
         process, etc.  Injudicious use results in the debugger not being able to debug
         interesting code, such as the debugger itself.  hence use primitive 19 with care :-)"
        "SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
        primitiveIndex = 19 ifTrue:
                [Debugger
                        openContext: self
                        label:'Code simulation error'
                        contents: nil].

        ((primitiveIndex between: 201 and: 222)
         and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
                [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
                  or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
                        [^receiver simulateValueWithArguments: arguments caller: self].
                 primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
                        [^receiver simulateValueWithArguments: arguments first caller: self]].

        primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
                [^self send: arguments first to: receiver with: arguments allButFirst super: false].
        primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
                [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
        primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
                [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].

        "Mutex>>primitiveEnterCriticalSection
         Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
        (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
                [| active effective |
                 active := Processor activeProcess.
                 effective := active effectiveProcess.
                 "active == effective"
                 value := primitiveIndex = 186
                                        ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
                                        ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
                 ^(self isPrimFailToken: value)
                        ifTrue: [value]
                        ifFalse: [self push: value]].

        primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
                [^MethodContext
                        sender: self
                        receiver: receiver
                        method: (arguments at: 2)
                        arguments: (arguments at: 1)].

        "Closure primitives"
        (primitiveIndex = 200 and: [self == receiver]) ifTrue:
                "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
                [^self push: (BlockClosure
                                                outerContext: receiver
                                                startpc: self pc + 2
                                                numArgs: arguments first
                                                copiedValues: arguments last)].

        primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
                [(arguments size = 2
                 and: [arguments first isInteger
                 and: [(self objectClass: arguments last) == Array]]) ifFalse:
                        [^self class primitiveFailTokenFor: nil].
                 ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].

        value := primitiveIndex = 120 "FFI method"
                                ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
                                ifFalse:
                                        [primitiveIndex = 117 "named primitives"
                                                ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
                                                ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]].

        ^(self isPrimFailToken: value)
                ifTrue: [value]
                ifFalse: [self push: value]!

----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
ContextPartPROTOTYPEisPrimFailToken: anObject
        <indirect>!

----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
ContextPartPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
        "Simulate the action of sending a message with selector and arguments
         to rcvr. The argument, lookupClass, is the class in which to lookup the
         message.  This is the receiver's class for normal messages, but for super
         messages it will be some specific class related to the source method."

        | meth primIndex val ctxt |
        (meth := lookupClass lookupSelector: selector) ifNil:
                [^self send: #doesNotUnderstand:
                                to: rcvr
                                with: {Message selector: selector arguments: arguments}
                                lookupIn: lookupClass].
        (primIndex := meth primitive) > 0 ifTrue:
                [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
                 (self isPrimFailToken: val) ifFalse:
                        [^val]].
        (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
                [^self error: 'Simulated message ', arguments first selector, ' not understood'].
        ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
        primIndex > 0 ifTrue:
                [ctxt failPrimitiveWith: val].
        ^ctxt!

----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEsend:to:with:super: (in category 'method prototypes') -----
ContextPartPROTOTYPEsend: selector to: rcvr with: arguments super: superFlag
        "Simulate the action of sending a message with selector arguments
         to rcvr. The argument, superFlag, tells whether the receiver of the
         message was specified with 'super' in the source method."

        ^self send: selector
                to: rcvr
                with: arguments
                lookupIn: (superFlag
                                        ifTrue: [self method methodClassAssociation value superclass]
                                        ifFalse: [self objectClass: rcvr])!

----- Method: SpurBootstrapCuisPrototypes>>ContextPartPROTOTYPEtryNamedPrimitiveIn:for:withArgs: (in category 'method prototypes') -----
ContextPartPROTOTYPEtryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
        "Invoke the named primitive for aCompiledMethod, answering its result, or,
         if the primiitve fails, answering the error code."
        <primitive: 218 error: ec>
        ec ifNotNil:
                ["If ec is an integer other than -1 there was a problem with primitive 218,
                  not with the external primitive itself.  -1 indicates a generic failure (where
                  ec should be nil) but ec = nil means primitive 218 is not implemented.  So
                  interpret -1 to mean the external primitive failed with a nil error code."
                 ec isInteger ifTrue:
                        [ec = -1
                                ifTrue: [ec := nil]
                                ifFalse: [self primitiveFailed]]].
        ^self class primitiveFailTokenFor: ec!

----- Method: SpurBootstrapCuisPrototypes>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') -----
IntegerclassPROTOTYPEinitialize
        "Integer initialize"
        self initializeLowBitPerByteTable!

----- Method: SpurBootstrapCuisPrototypes>>MethodContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
        <indirect>!

----- Method: SpurBootstrapCuisPrototypes>>MethodContextclassPROTOTYPEallInstances (in category 'method prototypes') -----
MethodContextclassPROTOTYPEallInstances
        "Answer all instances of the receiver."
        <primitive: 177>
        "The primitive can fail because memory is low.  If so, fall back on the old
         enumeration code, which gives the system a chance to GC and/or grow.
         Because aBlock might change the class of inst (for example, using become:),
         it is essential to compute next before aBlock value: inst.
         Only count until thisContext since this context has been created only to
         compute the existing instances."
        | inst insts next |
        insts := WriteStream on: (Array new: 64).
        inst := self someInstance.
        [inst == thisContext or: [inst == nil]] whileFalse:
                [next := inst nextInstance.
                 insts nextPut: inst.
                 inst := next].
        ^insts contents!

----- Method: SpurBootstrapCuisPrototypes>>MethodContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
MethodContextclassPROTOTYPEallInstancesDo: aBlock
        "Evaluate aBlock with each of the current instances of the receiver."
        | instances inst next |
        instances := self allInstancesOrNil.
        instances ifNotNil:
                [instances do: aBlock.
                 ^self].
        "allInstancesOrNil can fail because memory is low.  If so, fall back on the old
         enumeration code.  Because aBlock might change the class of inst (for example,
         using become:), it is essential to compute next before aBlock value: inst.
         Only count until thisContext since evaluation of aBlock will create new contexts."
        inst := self someInstance.
        [inst == thisContext or: [inst == nil]] whileFalse:
                [next := inst nextInstance.
                 aBlock value: inst.
                 inst := next]!

----- Method: SpurBootstrapCuisPrototypes>>MethodNodePROTOTYPEgenerate:using:ifQuick: (in category 'method prototypes') -----
MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass ifQuick: methodBlock
        <indirect>!

----- Method: SpurBootstrapCuisPrototypes>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes') -----
ProtoObjectPROTOTYPEscaledIdentityHash
        "For identityHash values returned by primitive 75, answer
         such values times 2^8.  Otherwise, match the existing
         identityHash implementation"

        ^self identityHash * 256 "bitShift: 8"!

----- Method: SpurBootstrapCuisPrototypes>>SmallIntegerPROTOTYPEclone (in category 'method prototypes') -----
SmallIntegerPROTOTYPEclone
        "Answer the receiver, because SmallIntegers are unique."
        ^self!

----- Method: SpurBootstrapCuisPrototypes>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
SmalltalkImagePROTOTYPErecreateSpecialObjectsArray
        <remove>!

----- Method: SpurBootstrapCuisPrototypes>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes') -----
SmalltalkImagePROTOTYPEsetGCParameters
        "Adjust the VM's default GC parameters to avoid too much tenuring.
         Maybe this should be left to the VM?"
        <remove>!

----- Method: SpurBootstrapCuisPrototypes>>SystemDictionaryPROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
SystemDictionaryPROTOTYPErecreateSpecialObjectsArray
        "Smalltalk recreateSpecialObjectsArray"
       
        "To external package developers:
        **** DO NOT OVERRIDE THIS METHOD.  *****
        If you are writing a plugin and need additional special object(s) for your own use,
        use addGCRoot() function and use own, separate special objects registry "
       
        "The Special Objects Array is an array of objects used by the Squeak virtual machine.
         Its contents are critical and accesses to it by the VM are unchecked, so don't even
         think of playing here unless you know what you are doing."
        | newArray |
        newArray := Array new: 60.
        "Nil false and true get used throughout the interpreter"
        newArray at: 1 put: nil.
        newArray at: 2 put: false.
        newArray at: 3 put: true.
        "This association holds the active process (a ProcessScheduler)"
        newArray at: 4 put: (self associationAt: #Processor).
        "Numerous classes below used for type checking and instantiation"
        newArray at: 5 put: Bitmap.
        newArray at: 6 put: SmallInteger.
        newArray at: 7 put: String.
        newArray at: 8 put: Array.
        newArray at: 9 put: Smalltalk.
        newArray at: 10 put: BoxedFloat64.
        newArray at: 11 put: MethodContext.
        newArray at: 12 put: nil. "was BlockContext."
        newArray at: 13 put: Point.
        newArray at: 14 put: LargePositiveInteger.
        newArray at: 15 put: Display.
        newArray at: 16 put: Message.
        newArray at: 17 put: CompiledMethod.
        newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
        newArray at: 19 put: Semaphore.
        newArray at: 20 put: Character.
        newArray at: 21 put: #doesNotUnderstand:.
        newArray at: 22 put: #cannotReturn:.
        newArray at: 23 put: nil. "This is the process signalling low space."
        "An array of the 32 selectors that are compiled as special bytecodes,
         paired alternately with the number of arguments each takes."
        newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
                                                        #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
                                                        #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
                                                        #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
        "An array of the 255 Characters in ascii order.
         Cog inlines table into machine code at: prim so do not regenerate it.
         This is nil in Spur, which has immediate Characters."
        newArray at: 25 put: (self specialObjectsArray at: 25).
        newArray at: 26 put: #mustBeBoolean.
        newArray at: 27 put: ByteArray.
        newArray at: 28 put: Process.
        "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
        newArray at: 29 put: self compactClassesArray.
        newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
        newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
        "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
        newArray at: 32 put: nil. "was the prototype Float"
        newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
        newArray at: 34 put: nil. "was the prototype Point"
        newArray at: 35 put: #cannotInterpret:.
        newArray at: 36 put: nil. "was the prototype MethodContext"
        newArray at: 37 put: BlockClosure.
        newArray at: 38 put: nil. "was the prototype BlockContext"
        "array of objects referred to by external code"
        newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
        newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
        newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
        newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
        newArray at: 43 put: LargeNegativeInteger.
        "External objects for callout.
         Note: Written so that one can actually completely remove the FFI."
        newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
        newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
        newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
        newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
        newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
        newArray at: 49 put: #aboutToReturn:through:.
        newArray at: 50 put: #run:with:in:.
        "51 reserved for immutability message"
        newArray at: 51 put: #attemptToAssign:withIndex:.
        newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
                                                        #'bad argument' #'bad index'
                                                        #'bad number of arguments'
                                                        #'inappropriate operation'  #'unsupported operation'
                                                        #'no modification' #'insufficient object memory'
                                                        #'insufficient C memory' #'not found' #'bad method'
                                                        #'internal error in named primitive machinery'
                                                        #'object may move' #'resource limit exceeded'
                                                        #'object is pinned' #'primitive write beyond end of object').
        "53 to 55 are for Alien"
        newArray at: 53 put: (self at: #Alien ifAbsent: []).
        newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
        newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).

        "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
        newArray at: 56 put: nil.

        "reserved for foreign callback process"
        newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).

        newArray at: 58 put: #unusedBytecode.
        "59 reserved for Sista counter tripped message"
        newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
        "60 reserved for Sista class trap message"
        newArray at: 60 put: #classTrapFor:.

        "Now replace the interpreter's reference in one atomic operation"
        self specialObjectsArray becomeForward: newArray!

----- Method: SpurBootstrapCuisPrototypes>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes') -----
SystemDictionaryPROTOTYPEsetGCParameters
        "Adjust the VM's default GC parameters to avoid too much tenuring.
         Maybe this should be left to the VM?"

        | proportion edenSize survivorSize averageObjectSize numObjects |
        proportion := 0.9. "tenure when 90% of pastSpace is full"
        edenSize := Smalltalk vmParameterAt: 44.
        survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
        averageObjectSize := 8 * self wordSize. "a good approximation"
        numObjects := (proportion * survivorSize / averageObjectSize) rounded.
        Smalltalk vmParameterAt: 6 put: numObjects  "tenure when more than this many objects survive the GC"!

----- Method: SpurBootstrapCuisPrototypes>>SystemDictionaryPROTOTYPEwordSize (in category 'method prototypes') -----
SystemDictionaryPROTOTYPEwordSize
        "Answer the size in bytes of an object pointer or word in the object memory.
         The value does not change for a given image, but may be modified by a SystemTracer
         when converting the image to another format."

        "Smalltalk wordSize"

        ^self vmParameterAt: 40!

SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapSqueak43Prototypes
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Bootstrapping'!

----- Method: SpurBootstrapSqueak43Prototypes class>>imageType (in category 'accessing') -----
imageType
        ^ 'squeak 4.3'!

----- Method: SpurBootstrapSqueak43Prototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
        <indirect>!

----- Method: SpurBootstrapSqueak43Prototypes>>CharacterPROTOTYPEshouldBePrintedAsLiteral (in category 'method prototypes') -----
CharacterPROTOTYPEshouldBePrintedAsLiteral

        ^(self asInteger between: 33 and: 255) and: [self asInteger ~= 127]!

----- Method: SpurBootstrapSqueak43Prototypes>>CompiledMethodPROTOTYPEencoderClass (in category 'method prototypes') -----
CompiledMethodPROTOTYPEencoderClass
        <indirect>!

----- Method: SpurBootstrapSqueak43Prototypes>>DecompilerPROTOTYPEdecompile:in:method:using: (in category 'method prototypes') -----
DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor
        <indirect>!

----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEinterpretExtension:in:for: (in category 'method prototypes') -----
InstructionStreamPROTOTYPEinterpretExtension: offset in: method for: client
        ^self interpretV3ClosuresExtension: offset in: method for: client!

----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEnextPc: (in category 'method prototypes') -----
InstructionStreamPROTOTYPEnextPc: currentByte
        <indirect>!

----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEskipCallPrimitive (in category 'method prototypes') -----
InstructionStreamPROTOTYPEskipCallPrimitive
        <indirect>!

----- Method: SpurBootstrapSqueak43Prototypes>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
MCClassDefinitionPROTOTYPEkindOfSubclass
        <indirect>!

----- Method: SpurBootstrapSqueak43Prototypes>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category 'method prototypes') -----
MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString
classIsMeta: metaBoolean
selector: selectorString
category: catString
timeStamp: timeString
source: sourceString
        <indirect>!

----- Method: SpurBootstrapSqueak43Prototypes>>MethodNodePROTOTYPEprintPropertiesOn: (in category 'method prototypes') -----
MethodNodePROTOTYPEprintPropertiesOn: aStream
        <indirect>!

----- Method: SpurBootstrapSqueakFamilyPrototypes class>>imageType (in category 'accessing') -----
imageType
        ^'squeak'!

----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
ClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
        "Compute the new format for making oldClass a subclass of newSuper.
         Answer the format or nil if there is any problem."
        | instSize isVar isWords isPointers isWeak |
        type == #compiledMethod ifTrue:
                [newInstSize > 0 ifTrue:
                        [self error: 'A compiled method class cannot have named instance variables'.
                        ^nil].
                ^CompiledMethod format].
        instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
        instSize > 65535 ifTrue:
                [self error: 'Class has too many instance variables (', instSize printString,')'.
                ^nil].
        type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
        type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
        type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
        type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
        type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
        type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
        type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
        (isPointers not and: [instSize > 0]) ifTrue:
                [self error: 'A non-pointer class cannot have named instance variables'.
                ^nil].
        ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!

----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
ClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: is32BitWords pointers: isPointers weak: isWeak
        "Compute the format for the given instance specfication.
         Above Cog Spur the class format is
                <5 bits inst spec><16 bits inst size>
         where the 5-bit inst spec is
                        0 = 0 sized objects (UndefinedObject True False et al)
                        1 = non-indexable objects with inst vars (Point et al)
                        2 = indexable objects with no inst vars (Array et al)
                        3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
                        4 = weak indexable objects with inst vars (WeakArray et al)
                        5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
                        6 = unused
                        7 = immediates (SmallInteger, Character)
                        8 = unused
                        9 = reserved for 64-bit indexable
                10-11 = 32-bit indexable (Bitmap)
                12-15 = 16-bit indexable
                16-23 = 8-bit indexable
                24-31 = compiled methods (CompiledMethod)"
        | instSpec |
        instSpec := isWeak
                                        ifTrue:
                                                [isVar
                                                        ifTrue: [4]
                                                        ifFalse: [5]]
                                        ifFalse:
                                                [isPointers
                                                        ifTrue:
                                                                [isVar
                                                                        ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
                                                                        ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
                                                        ifFalse:
                                                                [isVar
                                                                        ifTrue: [is32BitWords ifTrue: [10] ifFalse: [16]]
                                                                        ifFalse: [7]]].
        ^(instSpec bitShift: 16) + nInstVars!

----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
ClassBuilderPROTOTYPEsuperclass: aClass
        immediateSubclass: t instanceVariableNames: f
        classVariableNames: d poolDictionaries: s category: cat
        "This is the standard initialization message for creating a
         new immediate class as a subclass of an existing class."
        | env |
        aClass instSize > 0
                ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
        aClass isVariable
                ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
        aClass isPointers
                ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
        "Cope with pre-environment and environment versions. Simplify asap."
        env := (Smalltalk classNamed: #EnvironmentRequest)
                                ifNil: [aClass environment]
                                ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
        ^self
                name: t
                inEnvironment: env
                subclassOf: aClass
                type: #immediate
                instanceVariableNames: f
                classVariableNames: d
                poolDictionaries: s
                category: cat!

----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
ClassBuilderPROTOTYPEupdate: oldClass to: newClass
        "Convert oldClass, all its instances and possibly its meta class into newClass,
         instances of newClass and possibly its meta class. The process is surprisingly
         simple in its implementation and surprisingly complex in its nuances and potentially
         bad side effects.
         We can rely on two assumptions (which are critical):
                #1: The method #updateInstancesFrom: will not create any lasting pointers to
                         'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
                         a become of the old vs. the new instances and therefore it will not create
                         pointers to *new* instances before the #become: which are *old* afterwards)
                #2: The non-preemptive execution of the critical piece of code guarantees that
                         nobody can get a hold by 'other means' (such as process interruption and
                         reflection) on the old instances.
         Given the above two, we know that after #updateInstancesFrom: there are no pointers
         to any old instances. After the forwarding become there will be no pointers to the old
         class or meta class either.
         Andreas Raab, 2/27/2003 23:42"
        | meta |
        meta := oldClass isMeta.
        "Note: Everything from here on will run without the ability to get interrupted
        to prevent any other process to create new instances of the old class."
        ["Note: The following removal may look somewhat obscure and needs an explanation.
          When we mutate the class hierarchy we create new classes for any existing subclass.
          So it may look as if we don't have to remove the old class from its superclass. However,
          at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
          created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
          subclasses. Since the #become: below will transparently replace the pointers to oldClass
          with newClass the superclass would have newClass in its subclasses TWICE. With rather
          unclear effects if we consider that we may convert the meta-class hierarchy itself (which
          is derived from the non-meta class hierarchy).
          Due to this problem ALL classes are removed from their superclass just prior to converting
          them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
          effectively remove the oldClass (becomeForward:) just a few lines below."

                oldClass superclass removeSubclass: oldClass.
                oldClass superclass removeObsoleteSubclass: oldClass.

                "make sure that the VM cache is clean"
                oldClass methodDict do: [:cm | cm flushCache].
               
                "Convert the instances of oldClass into instances of newClass"
                newClass updateInstancesFrom: oldClass.

                meta
                        ifTrue:
                                [oldClass becomeForward: newClass.
                                 oldClass updateMethodBindingsTo: oldClass binding]
                        ifFalse:
                                [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
                                 oldClass updateMethodBindingsTo: oldClass binding.
                                 oldClass class updateMethodBindingsTo: oldClass class binding].

                "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
                 to ensure no old instances existed after the becomeForward:.  Without the GC it was possible
                 to resurrect old instances using e.g. allInstancesDo:.  This was because the becomeForward:
                 updated references from the old objects to new objects but didn't destroy the old objects.
                 But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
                        valueUnpreemptively!

----- Method: SpurBootstrapSqueakFamilyPrototypes>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
InstructionPrinterPROTOTYPEcallPrimitive: index
        "Print the callPrimitive bytecode."

        self print: 'callPrimitive: ' , index printString!

SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapSqueakPrototypes
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Bootstrapping'!

----- Method: SpurBootstrapSqueakPrototypes class>>imageType (in category 'accessing') -----
imageType
        ^ 'squeak'!

----- Method: SpurBootstrapSqueakPrototypes>>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.

         Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."

        <primitive: 175>
        self primitiveFailed!

----- Method: SpurBootstrapSqueakPrototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
        <indirect>!

----- Method: SpurBootstrapSqueakPrototypes>>CharacterPROTOTYPEclone (in category 'method prototypes') -----
CharacterPROTOTYPEclone
        "Answer the receiver, because Characters are unique."
        ^self!

----- Method: SpurBootstrapSqueakPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
CharacterPROTOTYPEsetValue: v
        <remove>!

----- Method: SpurBootstrapSqueakPrototypes>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category 'method prototypes') -----
ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
        <indirect>!

----- Method: SpurBootstrapSqueakPrototypes>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
ClassPROTOTYPEimmediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
        "This is the standard initialization message for creating a new
         immediate class as a subclass of an existing class (the receiver)."
        ^ClassBuilder new
                superclass: self
                immediateSubclass: t
                instanceVariableNames: f
                classVariableNames: d
                poolDictionaries: s
                category: cat!

----- Method: SpurBootstrapSqueakPrototypes>>CompiledMethodPROTOTYPEbytecodeSetName (in category 'method prototypes') -----
CompiledMethodPROTOTYPEbytecodeSetName
        ^self encoderClass name copyReplaceAll: 'EncoderFor' with: ''!

----- Method: SpurBootstrapSqueakPrototypes>>CompiledMethodPROTOTYPEheaderDescription (in category 'method prototypes') -----
CompiledMethodPROTOTYPEheaderDescription
        "Answer a description containing the information about the form of the
         receiver and the form of the context needed to run the receiver."

        ^(ByteString new: 128) writeStream
                print: self header; cr;
                nextPutAll: '"primitive: '; print: self primitive; cr;
                nextPutAll: ' numArgs: '; print: self numArgs; cr;
                nextPutAll: ' numTemps: '; print: self numTemps; cr;
                nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
                nextPutAll: ' frameSize: '; print: self frameSize; cr;
                nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
                nextPut: $"; cr;
                contents!

----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEactivateReturn:value: (in category 'method prototypes') -----
ContextPartPROTOTYPEactivateReturn: aContext value: value
        "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"

        ^MethodContext
                sender: self
                receiver: aContext
                method: MethodContext theReturnMethod
                arguments: {value}!

----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
        <indirect>!

----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
ContextPartPROTOTYPEisPrimFailToken: anObject
        <indirect>!

----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
ContextPartPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
        "Simulate the action of sending a message with selector and arguments
         to rcvr. The argument, lookupClass, is the class in which to lookup the
         message.  This is the receiver's class for normal messages, but for super
         messages it will be some specific class related to the source method."

        | meth primIndex val ctxt |
        (meth := lookupClass lookupSelector: selector) ifNil:
                [^self send: #doesNotUnderstand:
                                to: rcvr
                                with: {Message selector: selector arguments: arguments}
                                lookupIn: lookupClass].
        (primIndex := meth primitive) > 0 ifTrue:
                [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
                 (self isPrimFailToken: val) ifFalse:
                        [^val]].
        (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
                [^self error: 'Simulated message ', arguments first selector, ' not understood'].
        ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
        primIndex > 0 ifTrue:
                [ctxt failPrimitiveWith: val].
        ^ctxt!

----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEsend:to:with:super: (in category 'method prototypes') -----
ContextPartPROTOTYPEsend: selector to: rcvr with: arguments super: superFlag
        "Simulate the action of sending a message with selector arguments
         to rcvr. The argument, superFlag, tells whether the receiver of the
         message was specified with 'super' in the source method."

        ^self send: selector
                to: rcvr
                with: arguments
                lookupIn: (superFlag
                                        ifTrue: [self method methodClassAssociation value superclass]
                                        ifFalse: [self objectClass: rcvr])!

----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEtryNamedPrimitiveIn:for:withArgs: (in category 'method prototypes') -----
ContextPartPROTOTYPEtryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
        "Invoke the named primitive for aCompiledMethod, answering its result, or,
         if the primiitve fails, answering the error code."
        <primitive: 218 error: ec>
        ec ifNotNil:
                ["If ec is an integer other than -1 there was a problem with primitive 218,
                  not with the external primitive itself.  -1 indicates a generic failure (where
                  ec should be nil) but ec = nil means primitive 218 is not implemented.  So
                  interpret -1 to mean the external primitive failed with a nil error code."
                 ec isInteger ifTrue:
                        [ec = -1
                                ifTrue: [ec := nil]
                                ifFalse: [self primitiveFailed]]].
        ^self class primitiveFailTokenFor: ec!

----- Method: SpurBootstrapSqueakPrototypes>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') -----
IntegerclassPROTOTYPEinitialize
        "Integer initialize"
        self initializeLowBitPerByteTable!

----- Method: SpurBootstrapSqueakPrototypes>>MethodContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
        <indirect>!

----- Method: SpurBootstrapSqueakPrototypes>>MethodContextclassPROTOTYPEallInstances (in category 'method prototypes') -----
MethodContextclassPROTOTYPEallInstances
        "Answer all instances of the receiver."
        <primitive: 177>
        "The primitive can fail because memory is low.  If so, fall back on the old
         enumeration code, which gives the system a chance to GC and/or grow.
         Because aBlock might change the class of inst (for example, using become:),
         it is essential to compute next before aBlock value: inst.
         Only count until thisContext since this context has been created only to
         compute the existing instances."
        | inst insts next |
        insts := WriteStream on: (Array new: 64).
        inst := self someInstance.
        [inst == thisContext or: [inst == nil]] whileFalse:
                [next := inst nextInstance.
                 insts nextPut: inst.
                 inst := next].
        ^insts contents!

----- Method: SpurBootstrapSqueakPrototypes>>MethodContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
MethodContextclassPROTOTYPEallInstancesDo: aBlock
        "Evaluate aBlock with each of the current instances of the receiver."
        | instances inst next |
        instances := self allInstancesOrNil.
        instances ifNotNil:
                [instances do: aBlock.
                 ^self].
        "allInstancesOrNil can fail because memory is low.  If so, fall back on the old
         enumeration code.  Because aBlock might change the class of inst (for example,
         using become:), it is essential to compute next before aBlock value: inst.
         Only count until thisContext since evaluation of aBlock will create new contexts."
        inst := self someInstance.
        [inst == thisContext or: [inst == nil]] whileFalse:
                [next := inst nextInstance.
                 aBlock value: inst.
                 inst := next]!

----- Method: SpurBootstrapSqueakPrototypes>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes') -----
ProtoObjectPROTOTYPEscaledIdentityHash
        "For identityHash values returned by primitive 75, answer
         such values times 2^8.  Otherwise, match the existing
         identityHash implementation"

        ^self identityHash * 256 "bitShift: 8"!

----- Method: SpurBootstrapSqueakPrototypes>>SmallIntegerPROTOTYPEclone (in category 'method prototypes') -----
SmallIntegerPROTOTYPEclone
        "Answer the receiver, because SmallIntegers are unique."
        ^self!

----- Method: SpurBootstrapSqueakPrototypes>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
SmalltalkImagePROTOTYPErecreateSpecialObjectsArray
        "Smalltalk recreateSpecialObjectsArray"
       
        "To external package developers:
        **** DO NOT OVERRIDE THIS METHOD.  *****
        If you are writing a plugin and need additional special object(s) for your own use,
        use addGCRoot() function and use own, separate special objects registry "
       
        "The Special Objects Array is an array of objects used by the Squeak virtual machine.
         Its contents are critical and accesses to it by the VM are unchecked, so don't even
         think of playing here unless you know what you are doing."
        | newArray |
        newArray := Array new: 60.
        "Nil false and true get used throughout the interpreter"
        newArray at: 1 put: nil.
        newArray at: 2 put: false.
        newArray at: 3 put: true.
        "This association holds the active process (a ProcessScheduler)"
        newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
        "Numerous classes below used for type checking and instantiation"
        newArray at: 5 put: Bitmap.
        newArray at: 6 put: SmallInteger.
        newArray at: 7 put: ByteString.
        newArray at: 8 put: Array.
        newArray at: 9 put: Smalltalk.
        newArray at: 10 put: BoxedFloat64.
        newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
        newArray at: 12 put: nil. "was BlockContext."
        newArray at: 13 put: Point.
        newArray at: 14 put: LargePositiveInteger.
        newArray at: 15 put: Display.
        newArray at: 16 put: Message.
        newArray at: 17 put: CompiledMethod.
        newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
        newArray at: 19 put: Semaphore.
        newArray at: 20 put: Character.
        newArray at: 21 put: #doesNotUnderstand:.
        newArray at: 22 put: #cannotReturn:.
        newArray at: 23 put: nil. "This is the process signalling low space."
        "An array of the 32 selectors that are compiled as special bytecodes,
         paired alternately with the number of arguments each takes."
        newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
                                                        #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
                                                        #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
                                                        #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
        "An array of the 255 Characters in ascii order.
         Cog inlines table into machine code at: prim so do not regenerate it.
         This is nil in Spur, which has immediate Characters."
        newArray at: 25 put: (self specialObjectsArray at: 25).
        newArray at: 26 put: #mustBeBoolean.
        newArray at: 27 put: ByteArray.
        newArray at: 28 put: Process.
        "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
        newArray at: 29 put: self compactClassesArray.
        newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
        newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
        "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
        newArray at: 32 put: nil. "was the prototype Float"
        newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
        newArray at: 34 put: nil. "was the prototype Point"
        newArray at: 35 put: #cannotInterpret:.
        newArray at: 36 put: nil. "was the prototype MethodContext"
        newArray at: 37 put: BlockClosure.
        newArray at: 38 put: nil. "was the prototype BlockContext"
        "array of objects referred to by external code"
        newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
        newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
        newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
        newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
        newArray at: 43 put: LargeNegativeInteger.
        "External objects for callout.
         Note: Written so that one can actually completely remove the FFI."
        newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
        newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
        newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
        newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
        newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
        newArray at: 49 put: #aboutToReturn:through:.
        newArray at: 50 put: #run:with:in:.
        "51 reserved for immutability message"
        newArray at: 51 put: #attemptToAssign:withIndex:.
        newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
                                                        #'bad argument' #'bad index'
                                                        #'bad number of arguments'
                                                        #'inappropriate operation'  #'unsupported operation'
                                                        #'no modification' #'insufficient object memory'
                                                        #'insufficient C memory' #'not found' #'bad method'
                                                        #'internal error in named primitive machinery'
                                                        #'object may move' #'resource limit exceeded'
                                                        #'object is pinned' #'primitive write beyond end of object').
        "53 to 55 are for Alien"
        newArray at: 53 put: (self at: #Alien ifAbsent: []).
        newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
        newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).

        "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
        newArray at: 56 put: nil.

        "reserved for foreign callback process"
        newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).

        newArray at: 58 put: #unusedBytecode.
        "59 reserved for Sista counter tripped message"
        newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
        "60 reserved for Sista class trap message"
        newArray at: 60 put: #classTrapFor:.

        "Now replace the interpreter's reference in one atomic operation"
        self specialObjectsArray becomeForward: newArray!

----- Method: SpurBootstrapSqueakPrototypes>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes') -----
SmalltalkImagePROTOTYPEsetGCParameters
        "Adjust the VM's default GC parameters to avoid too much tenuring.
         Maybe this should be left to the VM?"

        | proportion edenSize survivorSize averageObjectSize numObjects |
        proportion := 0.9. "tenure when 90% of pastSpace is full"
        edenSize := SmalltalkImage current vmParameterAt: 44.
        survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
        averageObjectSize := 8 * self wordSize. "a good approximation"
        numObjects := (proportion * survivorSize / averageObjectSize) rounded.
        SmalltalkImage current vmParameterAt: 6 put: numObjects  "tenure when more than this many objects survive the GC"!

----- Method: SpurBootstrapSqueakPrototypes>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes') -----
SystemDictionaryPROTOTYPEsetGCParameters
        "Adjust the VM's default GC parameters to avoid too much tenuring.
         Maybe this should be left to the VM?"

        | proportion edenSize survivorSize averageObjectSize numObjects |
        proportion := 0.9. "tenure when 90% of pastSpace is full"
        edenSize := SmalltalkImage current vmParameterAt: 44.
        survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
        averageObjectSize := 8 * self wordSize. "a good approximation"
        numObjects := (proportion * survivorSize / averageObjectSize) rounded.
        SmalltalkImage current vmParameterAt: 6 put: numObjects  "tenure when more than this many objects survive the GC"!

Spur32BitMMLESimulator subclass: #SpurOldFormat32BitMMLESimulator
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Bootstrapping'!

----- Method: SpurOldFormat32BitMMLESimulator>>literalCountOfMethodHeader: (in category 'method access') -----
literalCountOfMethodHeader: header
        self assert: (self isIntegerObject: header).
        ^header >> 10 bitAnd: 16rFF!

----- Method: SpurOldFormat32BitMMLESimulator>>primitiveIndexOfMethodHeader: (in category 'method access') -----
primitiveIndexOfMethodHeader: methodHeader
        | primBits |
        primBits := (self integerValueOf: methodHeader) bitAnd: 16r100001FF.
        ^(primBits bitAnd: 16r1FF) + (primBits >> 19)!

SimulatorHarness subclass: #SpurBootstrap
        instanceVariableNames: 'oldHeap newHeap oldHeapSize newHeapSize oldHeapNumObjs newHeapNumObjs map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes installedMethodOops classMetaclass imageTypes classMethodContextIndex classBlockClosureIndex toBeInitialized'
        classVariableNames: 'ImageHeaderFlags ImageName ImageScreenSize TransformedImage'
        poolDictionaries: 'VMObjectIndices'
        category: 'CogAttic-Bootstrapping'!

!SpurBootstrap commentStamp: 'eem 9/11/2013 05:45' prior: 0!
SpurBootstrap bootstraps an image in SpurMemoryManager format from a Squeak V3 + closures format.

e.g.
        (SpurBootstrap32 new on: '/Users/eliot/Cog/startreader.image')
                transform;
                launch

Bootstrap issues:
- should it implement a deterministic Symbol identityHash? This means set a Symbol's identityHash at instance creation time
  based on its string hash so that e.g. MethodDIctionary instances have a deterministic order and don't need to be rehashed on load.
- should it collapse ContextPart and MethodContext down onto Context (and perhaps eliminate BlockContext)?

Instance Variables
        classToIndex: <Dictionary>
        lastClassTablePage: <Integer>
        map: <Dictionary>
        methodClasses: <Set>
        newHeap: <SpurMemoryManager>
        oldHeap: <NewObjectMemory>
        oldInterpreter: <StackInterpreterSimulator>
        reverseMap: <Dictionary>
        symbolMap: <Dictionary>

classToIndex
        - oldClass to new classIndex map

lastClassTablePage
        - oop in newHeap of last classTable page.  U<sed in validation to filter-out class table.

methodClasses
        - cache of methodClassAssociations for classes in which modified methods are installed

map
        - oldObject to newObject map

newHeap
        - the output, bootstrapped image

oldHeap
        - the input, image

oldInterpreter
        - the interpreter associated with oldHeap, needed for a hack to grab WeakArray

reverseMap
        - newObject to oldObject map

symbolMap
        - symbol toi symbol oop in oldHeap, used to map prototype methdos to methods in oldHeap!

----- Method: SpurBootstrap class>>bootstrapCuisImage: (in category 'utilities') -----
bootstrapCuisImage: imageFileBaseName
        self bootstrapImage: imageFileBaseName type: #('squeak' 'cuis')!

----- Method: SpurBootstrap class>>bootstrapImage:type: (in category 'utilities') -----
bootstrapImage: imageFileNameOrBaseName type: typeName
        "SpurBootstrap bootstrapImage: '/Users/eliot/Squeak/Squeak4.5/Squeak4.5-13680'"
        | imageFileBaseName imageFormat |
        imageFileBaseName := (imageFileNameOrBaseName endsWith: '.image')
                                                                ifTrue: [imageFileNameOrBaseName allButLast: 6]
                                                                ifFalse: [imageFileNameOrBaseName].
        imageFormat := ImageFormat fromFile: imageFileBaseName, '.image'.
        imageFormat requiresClosureSupport ifFalse:
                [self error: 'Can''t bootstrap this image since Spur assumes closure support.'].
        imageFormat requiresSpurSupport ifTrue:
                [self error: 'This image is already in Spur format.'].
        imageFormat is32Bit ifTrue:
                [^SpurBootstrap32 new bootstrapImage: imageFileBaseName type: typeName].
        self error: '64-bit support and 64-bit generation as-yet-unimplemented'!

----- Method: SpurBootstrap class>>bootstrapOldSqueakImage: (in category 'utilities') -----
bootstrapOldSqueakImage: imageFileBaseName
        "Try asnd bootstrap a pre-CompiledMethodTrailer Squeak image."
        self bootstrapImage: imageFileBaseName type: #('squeak' 'old squeak')!

----- Method: SpurBootstrap class>>bootstrapPharoImage: (in category 'utilities') -----
bootstrapPharoImage: imageFileBaseName
        | oldCompilerClass oldBytecodeBackend |
       
        oldCompilerClass := SmalltalkImage compilerClass.
        oldBytecodeBackend := CompilationContext bytecodeBackend.
        [
                SmalltalkImage compilerClass: Compiler.
                CompilationContext bytecodeBackend: IRSpurSqueakV3PlusClosuresBytecodeGenerator.
                self bootstrapImage: imageFileBaseName type: 'pharo' ]
        ensure: [
                SmalltalkImage compilerClass: oldCompilerClass.
                CompilationContext bytecodeBackend: oldBytecodeBackend ]!

----- Method: SpurBootstrap class>>bootstrapSqueakImage: (in category 'utilities') -----
bootstrapSqueakImage: imageFileBaseName
        self bootstrapImage: imageFileBaseName type: 'squeak'!

----- Method: SpurBootstrap class>>categoryForClass:meta:selector: (in category 'method prototype categorization') -----
categoryForClass: className meta: isMeta selector: selector
        ^(isMeta
                        ifTrue: [{ className. #class. selector }]
                        ifFalse: [{ className. selector }])
                caseOf: {
                        [#(Behavior allInstancesOrNil)] -> [#enumerating].
                        [#(Behavior byteSizeOfInstance)] -> [#'accessing instances and variables'].
                        [#(Behavior byteSizeOfInstanceOfSize:)] -> [#'accessing instances and variables'].
                        [#(Behavior elementSize)] -> [#'accessing instances and variables'].
                        [#(Behavior handleFailingBasicNew)] -> [#private].
                        [#(Behavior handleFailingBasicNew:)] -> [#private].
                        [#(Behavior handleFailingFailingBasicNew)] -> [#private].
                        [#(Behavior handleFailingFailingBasicNew:)] -> [#private].
                        [#(Behavior identityHash)] -> [#comparing].
                        [#(Behavior isCompiledMethodClass)] -> [#testing].
                        [#(Behavior isEphemeronClass)] -> [#testing].
                        [#(Behavior isImmediateClass)] -> [#testing].
                        [#(BoxedFloat64 class basicNew)] -> [#'instance creation'].
                        [#(BoxedFloat64 class basicNew:)] -> [#'instance creation'].
                        [#(Character identityHash)] -> [#comparing].
                        [#(Character setValue:)] -> [#accessing].
                        [#(Class immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
                                                                                                                        -> [#'subclass creation'].
                        [#(ClassBuilder superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
                                                                                                                        -> [#public].
                        [#(CompiledMethod bytecodeSetName)] -> [#accessing].
                        [#(CompiledMethod class handleFailingFailingNewMethod:header:)]
                                                                                                                        -> [#private].
                        [#(CompiledMethod class handleFailingNewMethod:header:)]
                                                                                                                        -> [#private].
                        [#(CompiledMethod class headerFlagForEncoder:)]
                                                                                                                        -> [#'method encoding'].
                        [#(CompiledMethod class installPrimaryBytecodeSet:)]
                                                                                                                        -> [#'class initialization'].
                        [#(CompiledMethod class installSecondaryBytecodeSet:)]
                                                                                                                        -> [#'class initialization'].
                        [#(Context class allInstances)] -> [#enumerating].
                        [#(Context class allInstancesDo:)] -> [#enumerating].
                        [#(Context failPrimitiveWith:)] -> [#'system simulation'].
                        [#(Context isPrimFailToken:)] -> [#private].
                        [#(Context send:to:with:lookupIn:)] -> [#controlling].
                        [#(ContextPart isPrimFailToken:)] -> [#private].
                        [#(ContextPart send:to:with:lookupIn:)] -> [#controlling].
                        [#(EncoderForV3 computeMethodHeaderForNumArgs:numTemps:numLits:primitive:)]
                                                                                                                        -> [#'method encoding'].
                        [#(EncoderForV3PlusClosures genCallPrimitive:)]
                                                                                                                        -> [#'bytecode generation'].
                        [#(EncoderForV3PlusClosures class callPrimitiveCode)]
                                                                                                                        -> [#'bytecode decoding'].
                        [#(InstructionClient callPrimitive:)] -> [#'instruction decoding'].
                        [#(MethodContext failPrimitiveWith:)] -> [#'system simulation'].
                        [#(MethodContext class allInstances)] -> [#enumerating].
                        [#(MethodContext class allInstancesDo:)] -> [#enumerating].
                        [#(Object isPinned)] -> [#'system primitives'].
                        [#(Object pin)] -> [#'system primitives'].
                        [#(Object setPinned:)] -> [#'system primitives'].
                        [#(Object unpin)] -> [#'system primitives'].
                        [#(SmallFloat64 class basicNew)] -> [#'instance creation'].
                        [#(SmallFloat64 class basicNew:)] -> [#'instance creation'].
                        [#(SmallFloat64 clone)] -> [#copying].
                        [#(SmallFloat64 copy)] -> [#copying].
                        [#(SmallFloat64 deepCopy)] -> [#copying].
                        [#(SmallFloat64 identityHash)] -> [#comparing].
                        [#(SmallFloat64 shallowCopy)] -> [#copying].
                        [#(SmallFloat64 veryDeepCopyWith:)] -> [#copying].
                        [#(SmallInteger asCharacter)] -> [#converting].
                        [#(SmalltalkImage growMemoryByAtLeast:)] -> [#'memory space'].
                        [#(SmalltalkImage maxIdentityHash)] -> [#'system attributes'].
                        [#(SystemDictionary growMemoryByAtLeast:)] -> [#'memory space'].
                        [#(SystemDictionary maxIdentityHash)] -> [#'system attributes'].
                        [#(SystemDictionary setGCParameters)] -> [#'snapshot and quit'].
                        [#(SystemNavigation allObjects)] -> [#query].
                        [#(SystemNavigation allObjectsOrNil)] -> [#query].
                         }
                otherwise:
                        [Transcript nextPutAll: className.
                         isMeta ifTrue: [Transcript nextPutAll: ' class'].
                         Transcript nextPutAll: '>>'; store: selector; nextPutAll: ' is unclassified'; cr; flush.
                         ^Categorizer default]!

----- Method: SpurBootstrap class>>defaultIntegerBaseInDebugger (in category 'debugger') -----
defaultIntegerBaseInDebugger
        ^16!

----- Method: SpurBootstrap class>>isolatedPrototypes (in category 'utilities') -----
isolatedPrototypes
        "SpurBootstrap isolatedPrototypes"
        | prototypes |
        prototypes := (self systemNavigation allMethodsSelect:
                                                [:m| m selector includesSubString: 'PROTOTYPE'])
                                                        collect: [:mr| mr compiledMethod].
        ^prototypes select:
                [:m|
                (m methodClass includesBehavior: SpurBootstrapPrototypes)
                        ifTrue:
                                [(m pragmaAt: #indirect) notNil
                                  and: [prototypes noneSatisfy:
                                                [:p|
                                                p selector == m selector
                                                and: [p methodClass ~~ m methodClass]]]]
                        ifFalse:
                                [prototypes noneSatisfy:
                                        [:p|
                                        p selector == m selector
                                        and: [(p methodClass includesBehavior: SpurBootstrapPrototypes)
                                        and: [(p pragmaAt: #indirect) notNil]]]]]!

----- Method: SpurBootstrap class>>testComputeFormat (in category 'tests') -----
testComputeFormat
        "self testComputeFormat"
        #( (normal 0)
                (bytes 16)
                (words 12)
                (variable 2)
                (weak 4)
                (ephemeron 5)
                (immediate 7)
                (compiledMethod 24)) do:
                [:tuple|
                 [:type :instSpec| | fmt |
                   fmt := [self ClassBuilderPROTOTYPEcomputeFormat: type instSize: 0 forSuper: Object ccIndex: 0]
                                        on: MessageNotUnderstood
                                        do: [:ex|
                                                ex message selector ~~ #format:variable:words:pointers:weak: ifTrue:
                                                        [ex pass].
                                                self perform: #ClassBuilderPROTOTYPEformat:variable:words:pointers:weak:
                                                        withArguments: ex message arguments].
                   self assert: (fmt >> 16 = instSpec
                                                or: [type = #compiledMethod and: [fmt = CompiledMethod format]]).
                 ] valueWithArguments: tuple]!

----- Method: SpurBootstrap>>addMissingClassVars: (in category 'bootstrap image') -----
addMissingClassVars: classVars
        "Add any missing class vars given classVars, a Dictionary from nonMetaClass to binding.
         Initialize any classes that get inst vars added."
        | addClassVarNameSym bindingOfSym |
        classVars isEmpty ifTrue:
                [^self].
        addClassVarNameSym := self findSymbol: #addClassVarName:.
        addClassVarNameSym ifNil:
                [addClassVarNameSym := self findSymbol: #addClassVarNamed:].
        bindingOfSym := self findSymbol: #bindingOf:.
        classVars keysAndValuesDo:
                [:binding :class|
                Transcript cr;  nextPutAll: 'ADDING CLASS VAR '; store: binding key; nextPutAll: ' TO '; print: class; flush.
                self interpreter: oldInterpreter
                        object: (self oldClassOopFor: class)
                        perform: addClassVarNameSym
                        withArguments: {oldHeap stringForCString: binding key}.
                literalMap
                        at: binding
                        put: (self interpreter: oldInterpreter
                                        object: (self oldClassOopFor: class)
                                        perform: bindingOfSym
                                        withArguments: {self findSymbol: binding key})].
        toBeInitialized := classVars asSet!

----- Method: SpurBootstrap>>addNewMethods (in category 'bootstrap methods') -----
addNewMethods
        "Get the simulator to add any and all missing methods immediately."
        | cmaiaSym basSym |
        cmaiaSym := self findSymbol: #compiledMethodAt:ifAbsent:.
        basSym := self findSymbol: #basicAddSelector:withMethod:.
        basSym ifNil:
                [basSym := self findSymbol: #addSelectorSilently:withMethod:].
        self allPrototypeClassNamesDo:
                [:sym :symIsMeta|
                (self findClassNamed: (literalMap at: sym))
                        ifNil: [Transcript
                                        cr;
                                        nextPutAll: 'not installing any methods for ';
                                        nextPutAll: sym;
                                        nextPutAll: '; class not found in image';
                                        flush.]
                        ifNotNil:
                                [:theClass| | class |
                                class := symIsMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass].
                                self prototypeClassNameMetaSelectorMethodDo:
                                        [:className :isMeta :selector :method| | methodOrNil |
                                        (className = sym
                                         and: [symIsMeta = isMeta
                                         and: [(method pragmaAt: #remove) isNil]]) ifTrue:
                                                ["probe method dictionary of the class for each method, installing a dummy if not found."
                                                 "Transcript cr; nextPutAll: 'checking for '; nextPutAll: selector; flush."
                                                 methodOrNil := self interpreter: oldInterpreter
                                                                                        object: class
                                                                                        perform: cmaiaSym
                                                                                        withArguments: {literalMap at: selector. oldHeap nilObject}.
                                                 methodOrNil = oldHeap nilObject
                                                        ifTrue: "no method.  install the real thing now"
                                                                [Transcript
                                                                        cr;
                                                                        nextPutAll: 'installing ';
                                                                        nextPutAll: className;
                                                                        nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
                                                                        store: selector;
                                                                        flush.
                                                                 self interpreter: oldInterpreter
                                                                        object: class
                                                                        perform: basSym
                                                                        withArguments: { literalMap at: selector.
                                                                                                           self installableMethodFor: method
                                                                                                                selector: selector
                                                                                                                className: className
                                                                                                                isMeta: isMeta}.
                                                                installedPrototypes add: method selector]
                                                        ifFalse: "existing method; collect the methodClassAssociation; its needed later"
                                                                [methodClasses add: (oldInterpreter methodClassAssociationOf: methodOrNil)]]]]]!

----- Method: SpurBootstrap>>allInstancesOf: (in category 'bootstrap methods') -----
allInstancesOf: classOop
        | instances |
        instances := OrderedCollection new.
        oldHeap allObjectsDo:
                [:o|
                ((oldHeap isPointersNonImm: o)
                 and: [(oldHeap fetchClassOf: o) = classOop]) ifTrue:
                        [instances addLast: o]].
        ^instances!

----- Method: SpurBootstrap>>allMethodPrototypes (in category 'method prototypes') -----
allMethodPrototypes
        "Answer all prototype selectors, including those marked <remove>"
        ^(imageTypes
                inject: (IdentitySet withAll: SpurBootstrapPrototypes allMethodPrototypes)
                into: [:allPrototypes :type | | prototypes |
                        prototypes := (SpurBootstrapPrototypes prototypeClassFor: type) allMethodPrototypes.
                        allPrototypes
                                removeAllSuchThat: [:existing| prototypes anySatisfy: [:new| existing selector == new selector]];
                                addAll: (prototypes reject: [:prototype| (prototype pragmaAt: #ignore) notNil]);
                                yourself])
                asArray sort: [:ma :mb| ma selector <= mb selector]!

----- Method: SpurBootstrap>>allPrototypeClassNamesDo: (in category 'method prototypes') -----
allPrototypeClassNamesDo: aBlock
        "self basicNew allPrototypeClassNames"
        | pairs |
        pairs := Set new.
        self prototypeClassNameMetaSelectorMethodDo:
                [:className :isMeta :selector :method |
                pairs add: {className. isMeta}].
        pairs do: [:pair| aBlock value: pair first value: pair last]!

----- Method: SpurBootstrap>>allPrototypeMethodSymbols (in category 'method prototypes') -----
allPrototypeMethodSymbols
        "self basicNew allPrototypeMethodSymbols"
        | symbols |
        self assert: SpurBootstrap isolatedPrototypes isEmpty.
        symbols := Set new.
        self prototypeClassNameMetaSelectorMethodDo:
                [:className :isMeta :selector :method | | adder |
                symbols
                        add: className;
                        add: selector.
                adder := [:lit|
                                   (lit isSymbol and: [lit ~~ method selector]) ifTrue: [symbols add: lit].
                                   lit isArray ifTrue: [lit do: adder]].
                method literals do: adder].
        ^symbols!

----- Method: SpurBootstrap>>allocateClassTable (in category 'bootstrap image') -----
allocateClassTable
        "Allocate the root of the classTable plus enough pages to accomodate all classes in
         the classToIndex map.  Don't fill in the entries yet; the classes have yet to be cloned."
        | tableRoot page maxSize numPages |
        tableRoot := newHeap
                                        allocateSlots: newHeap classTableRootSlots + newHeap hiddenRootSlots
                                        format: newHeap arrayFormat
                                        classIndex: newHeap arrayClassIndexPun.
        self assert: (newHeap numSlotsOf: tableRoot) = (newHeap classTableRootSlots + newHeap hiddenRootSlots).
        self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat.
        self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun.
        newHeap nilFieldsOf: tableRoot.
        "first page is strong"
        page := newHeap
                                        allocateSlots: newHeap classTablePageSize
                                        format: newHeap arrayFormat
                                        classIndex: newHeap arrayClassIndexPun.
        self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize.
        self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat.
        self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun.
        self assert: (newHeap objectAfter: tableRoot limit: newHeap freeStart) = page.
        lastClassTablePage := page.
        newHeap nilFieldsOf: page.
        newHeap storePointer: 0 ofObject: tableRoot withValue: page.
        newHeap setHiddenRootsObj: tableRoot.
        maxSize := classToIndex inject: 0 into: [:a :b| a max: b].
        numPages := (maxSize + newHeap classTableMinorIndexMask / newHeap classTablePageSize) truncated.
        2 to: numPages do:
                [:i|
                page := newHeap
                                        allocateSlots: newHeap classTablePageSize
                                        format: newHeap arrayFormat
                                        classIndex: newHeap arrayClassIndexPun.
                self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize.
                self assert: (newHeap formatOf: page) = newHeap arrayFormat.
                self assert: (newHeap classIndexOf: page) = newHeap arrayClassIndexPun.
                newHeap fillObj: page numSlots: newHeap classTablePageSize with: newHeap nilObject.
                newHeap storePointer: i - 1 ofObject: tableRoot withValue: page.
                self assert: (newHeap objectAfter: (newHeap fetchPointer: i - 2 ofObject: tableRoot)  limit: newHeap freeStart) = page.
                lastClassTablePage := page].
        "and once again to recompute numClassTablePages post building the class table."
        newHeap instVarNamed: 'numClassTablePages' put: nil.
        newHeap setHiddenRootsObj: tableRoot!

----- Method: SpurBootstrap>>allocateFreeLists (in category 'bootstrap image') -----
allocateFreeLists
        "Allocate the freeLists array."
        | freeListsOop |
        freeListsOop := newHeap
                                                allocateSlots: newHeap numFreeLists
                                                format: newHeap wordIndexableFormat
                                                classIndex: newHeap wordSizeClassIndexPun.
        self assert: (newHeap objectAfter: newHeap trueObject) = freeListsOop.
        0 to: newHeap numFreeLists - 1 do:
                [:i|
                newHeap
                        storePointerUnchecked: i
                        ofObject: freeListsOop
                        withValue: 0]!

----- Method: SpurBootstrap>>bootstrapImage (in category 'bootstrap image') -----
bootstrapImage
        oldHeap fullGC.
        self measureOldHeapPostGC.
        self initMaps.
        Transcript cr; nextPutAll: 'transforming image...'; flush.
        self cloneNilTrueAndFalse.
        self allocateFreeLists.
        self buildClassMap.
        self allocateClassTable.
        self cloneObjects.
        self fillInObjects.
        self fillInClassTable.
        newHeapSize := newHeap freeStart.
        newHeap initializePostBootstrap.
        self measureNewHeapPostInitPostBootstrap!

----- Method: SpurBootstrap>>bootstrapImage: (in category 'public access') -----
bootstrapImage: imageName
        (Smalltalk classNamed: #FileReference) ifNotNil:
                [^self bootstrapImageUsingFileReference: imageName].
        (Smalltalk classNamed: #FileDirectory) ifNotNil:
                [^self bootstrapImageUsingFileDirectory: imageName].
        self error: 'at a loss as to what file system support to use'!

----- Method: SpurBootstrap>>bootstrapImage:type: (in category 'public access') -----
bootstrapImage: imageName type: typeNameOrArrayOfTypeNames
        "type can be:
                - 'squeak'
                - {'old squeak' 'squeak' }
                - { 'cuis' 'squeak' }
                - 'pharo'
                - it might be 'newspeak', if needed (but is not implemented)"
        imageTypes := typeNameOrArrayOfTypeNames isArray
                                                ifTrue: [typeNameOrArrayOfTypeNames]
                                                ifFalse: [{typeNameOrArrayOfTypeNames}].
        self bootstrapImage: imageName
        !

----- Method: SpurBootstrap>>bootstrapImageUsingFileDirectory: (in category 'public access') -----
bootstrapImageUsingFileDirectory: imageName
        | dirName baseName dir |
        dirName := FileDirectory dirPathFor: imageName.
        baseName := (imageName endsWith: '.image')
                                        ifTrue: [FileDirectory baseNameFor: imageName]
                                        ifFalse: [FileDirectory localNameFor: imageName].
        dir := dirName isEmpty ifTrue: [FileDirectory default] ifFalse: [FileDirectory default on: dirName].
        self on: (dir fullNameFor: baseName, '.image').
        [self transform]
                on: Halt
                do: [:ex|
                        "suppress halts from the usual suspects (development time halts)"
                        (#(fullGC compactImage) includes: ex signalerContext sender selector)
                                ifTrue: [ex resume]
                                ifFalse: [ex pass]].
        self writeSnapshot: (dir fullNameFor: baseName, '-spur.image')
                ofTransformedImage: newHeap
                headerFlags: oldInterpreter getImageHeaderFlags
                screenSize: oldInterpreter savedWindowSize.
        dir deleteFileNamed: baseName, '-spur.changes';
                copyFileNamed: baseName, '.changes' toFileNamed: baseName, '-spur.changes'!

----- Method: SpurBootstrap>>bootstrapImageUsingFileReference: (in category 'public access') -----
bootstrapImageUsingFileReference: imageName
        | dirName baseName dir |
        dirName := imageName asFileReference parent fullName.
        baseName := (imageName endsWith: '.image')
                ifTrue: [ imageName asFileReference base ]
                ifFalse: [ (imageName, '.image') asFileReference base ].
        dir := dirName asFileReference.
        self on: (dir / (baseName, '.image')) fullName.
        [self transform]
                on: Halt
                do: [:ex|
                        "suppress halts from the usual suspects (development time halts)"
                        (#(fullGC compactImage) includes: ex signalerContext sender selector)
                                ifTrue: [ex resume]
                                ifFalse: [ex pass]].
        self writeSnapshot: (dir / (baseName, '-spur.image')) fullName
                ofTransformedImage: newHeap
                headerFlags: oldInterpreter getImageHeaderFlags
                screenSize: oldInterpreter savedWindowSize.
        (dir / (baseName, '.changes')) copyTo: (dir / (baseName, '-spur.changes'))!

----- Method: SpurBootstrap>>buildClassMap (in category 'bootstrap image') -----
buildClassMap
        "enumerate all objects asking isBehavior:?  (class == Metaclass or class class == Metaclass) doesn't work for Newspeak"
        "Build a map from all classes in oldHeap to a class index.
         ONLY DEALS WITH CLASSES THAT HAVE INSTANCES!!!! (can walk superclass chain?  Can walk subclasses set? Can ask class == Metaclass or class class == Metaclass class?)"
        | classes classTableIndex |
        self defineKnownClassIndices.
        classes := classToIndex keys asSet.
        classTableIndex := classToIndex inject: 0 into: [:a :b| a max: b].
        oldHeap allObjectsDo:
                [:oldObj| | oldClass |
                 oldClass := oldHeap fetchClassOfNonImm: oldObj.
                 self assert: (oldHeap isPointersNonImm: oldClass).
                 (classes includes: oldClass) ifFalse:
                        [classes add: oldClass.
                         classToIndex at: oldClass put: (classTableIndex := classTableIndex + 1)]]!

----- Method: SpurBootstrap>>checkReshapeOf: (in category 'bootstrap image') -----
checkReshapeOf: ourMethodClasses
        "Check the shape of all our method classes match the shape of those in the image to be bootstrapped.
         Use the simulator to redefine any that need it.  Does /not/ reshape metaclasses; these we assume are ok."
        | toReshape |
        toReshape := Set new.
        ourMethodClasses do:
                [:mc|
                (literalMap at: mc binding ifAbsent: []) ifNotNil:
                        [:binding|
                        (mc ~~ Character "Character will reshape anyway"
                         and: [mc instSize ~= (oldHeap instanceSizeOf: (oldHeap fetchPointer: ValueIndex ofObject: binding))]) ifTrue:
                                [toReshape add: mc]]].
        toReshape isEmpty ifTrue:
                [^self].
        self interpreter: oldInterpreter
                        object: (self oldClassOopFor: ClassBuilder)
                        perform: (self findSymbol: #beSilent:)
                        withArguments: {oldHeap trueObject}.
        "Assume only one class in any subtree needs reshaping.  Fast and loose but gets us there for now."
        toReshape copy do:
                [:class|
                toReshape removeAll: (toReshape select: [:ea| ea inheritsFrom: class])].
        toReshape do:
                [:class|
                Transcript cr;  nextPutAll: 'RESHAPING '; print: class; flush.
                self interpreter: oldInterpreter
                        object: (self oldClassOopFor: Compiler)
                        perform: (self findSymbol: #evaluate:)
                        withArguments: {oldHeap stringForCString: class definition}]!

----- Method: SpurBootstrap>>classMetaclass (in category 'bootstrap image') -----
classMetaclass
        ^classMetaclass ifNil:
                [classMetaclass := oldHeap fetchClassOfNonImm: (oldHeap fetchClassOfNonImm: oldHeap classArray)]!

----- Method: SpurBootstrap>>classNameForPrototypeMethod: (in category 'method prototypes') -----
classNameForPrototypeMethod: protoMethod
        | protoSelector |
        protoSelector := protoMethod selector.
        #('OLDSQUEAKPROTOTYPE' 'SQUEAKPROTOTYPE' 'PHAROPROTOTYPE' 'PROTOTYPE') do:
                [:prototype| | index |
                (index := protoSelector indexOfSubCollection: prototype) ~= 0 ifTrue:
                        [^(protoSelector first: index - 1) asSymbol]].
        self error: 'really??'!

----- Method: SpurBootstrap>>classTableSize (in category 'class indices') -----
classTableSize
        ^newHeap classIndexMask + 1!

----- Method: SpurBootstrap>>clone:classIndex: (in category 'bootstrap image') -----
clone: oldObj classIndex: classIndex
        | newObj format numBytes |
        ((format := oldHeap formatOf: oldObj) >= oldHeap firstLongFormat
         and: [numBytes := oldHeap numBytesOf: oldObj.
                format >= oldHeap firstCompiledMethodFormat
                and: [(oldInterpreter primitiveIndexOf: oldObj) > 0]]) ifTrue:
                        [numBytes := numBytes + 3].
        newObj := newHeap
                                allocateSlots: (format >= oldHeap firstLongFormat
                                                                ifTrue: [newHeap numSlotsForBytes: numBytes]
                                                                ifFalse: [oldHeap numSlotsOf: oldObj])
                                format: (self newFormatFor: oldObj numBytes: numBytes)
                                classIndex: classIndex.
        reverseMap at: newObj put: oldObj.
        ^map at: oldObj put: newObj!

----- Method: SpurBootstrap>>cloneArrayLiteral: (in category 'bootstrap methods') -----
cloneArrayLiteral: anArray
        "Currently serves only to clone the #(0 0) literal in SpaceTallyPROTOTYPEspaceForInstancesOf:"
        | array |
        array := oldHeap instantiateClass: (oldHeap splObj: ClassArray) indexableSize: anArray size.
        1 to: anArray size do:
                [:i| | lit |
                lit := anArray at: i.
                lit class caseOf: {
                        [SmallInteger] -> [oldHeap
                                                                        storePointerUnchecked: i - 1
                                                                        ofObject: array
                                                                        withValue: (oldHeap integerObjectOf: lit)].
                        [ByteSymbol] -> [oldHeap
                                                                        storePointer: i - 1
                                                                        ofObject: array
                                                                        withValue: (self findSymbol: lit)].
                        [UndefinedObject] -> [oldHeap
                                                                        storePointerUnchecked: i - 1
                                                                        ofObject: array
                                                                        withValue: oldHeap nilObject] }].
        ^array
!

----- Method: SpurBootstrap>>cloneMethodProxy: (in category 'bootstrap methods') -----
cloneMethodProxy: proxy "<VMCompiledMethodProxy>"
        | bytes newMethod delta |
        bytes := proxy size - proxy initialPC + 1.
        delta := proxy primitive > 0
                                ifTrue: [3]
                                ifFalse: [0].
        newMethod := CompiledMethod
                                                newMethod: bytes + delta
                                                header: (self headerForOldMethodHeader: (oldHeap integerObjectOf: proxy header)).
        1 to: proxy numLiterals - 1 do:
                [:i| newMethod literalAt: i put: (proxy literalAt: i)].
        newMethod
                literalAt: proxy numLiterals
                put: (Smalltalk bindingOf: #Character).
        delta > 0 ifTrue:
                [newMethod
                        at: newMethod initialPC + 0 put: 139;
                        at: newMethod initialPC + 1 put: (proxy primitive bitAnd: 16rFF);
                        at: newMethod initialPC + 2 put: (proxy primitive bitShift: -8)].
        proxy initialPC to: proxy size do:
                [:i| newMethod at: i + delta put: (proxy at: i)].
        ^newMethod!

----- Method: SpurBootstrap>>cloneNilTrueAndFalse (in category 'bootstrap image') -----
cloneNilTrueAndFalse
        { oldHeap nilObject.
                oldHeap falseObject.
                oldHeap trueObject. }
                with: (self firstOrdinaryClassIndex to: self firstOrdinaryClassIndex + 2)
                do: [:obj :classIndex|
                        classToIndex at: (oldHeap fetchClassOfNonImm: obj) put: classIndex.
                        self clone: obj classIndex: classIndex].
        newHeap
                nilObject: (map at: oldHeap nilObject); "needed for nilling objects etc"
                falseObject: (map at: oldHeap falseObject);
                trueObject: (map at: oldHeap trueObject)!

----- Method: SpurBootstrap>>cloneObjects (in category 'bootstrap image') -----
cloneObjects
        | specialObjectsArray characterClass characterTable compactClasses oldObj oldClass |
        specialObjectsArray := oldHeap specialObjectsOop.
        characterClass := oldHeap classCharacter.
        characterTable := oldHeap characterTable.
        compactClasses := oldHeap splObj: CompactClasses.
        self clone: specialObjectsArray
                classIndex: (classToIndex at: (oldHeap fetchClassOfNonImm: specialObjectsArray)).
        oldObj := oldHeap objectAfter: oldHeap trueObject.
        [oldObj < oldHeap freeStart] whileTrue:
                [oldClass := oldHeap fetchClassOfNonImm: oldObj.
                 (oldObj ~= characterTable
                 and: [oldObj ~= specialObjectsArray
                 and: [oldObj ~= compactClasses
                 and: [oldClass ~= characterClass]]]) ifTrue:
                        [self clone: oldObj classIndex: (classToIndex at: oldClass)].
                 oldObj := oldHeap objectAfter: oldObj].
        newHeap
                specialObjectsOop: (map at: oldHeap specialObjectsOop);
                lastHash: oldHeap lastHash!

----- Method: SpurBootstrap>>coHeapFrom: (in category 'testing') -----
coHeapFrom: aSpur32BitMMLESimulator
        | coHeap |
        coHeap := Spur32BitMMLECoSimulator new.
        aSpur32BitMMLESimulator class allInstVarNames do:
                [:ivn|
                coHeap instVarNamed: ivn put: (aSpur32BitMMLESimulator instVarNamed: ivn)].
        coHeap scavenger instVarNamed: 'manager' put: coHeap.
        ^coHeap!

----- Method: SpurBootstrap>>compactImage (in category 'bootstrap image') -----
compactImage
        | firstFree lastUsed |
        newHeap allHeapEntitiesDo:
                [:o|
                (newHeap isFreeObject: o)
                        ifTrue: [firstFree ifNil: [firstFree := o]]
                        ifFalse: [lastUsed := o]].
        lastUsed < firstFree ifTrue: "nothing to do"
                [^self].
        self halt!

----- Method: SpurBootstrap>>convertOldMethodHeader: (in category 'bootstrap image') -----
convertOldMethodHeader: methodHeader
        ^((oldInterpreter argumentCountOfMethodHeader: methodHeader) << 24)
         + ((oldInterpreter temporaryCountOfMethodHeader: methodHeader) << 18)
         + ((oldInterpreter methodHeaderIndicatesLargeFrame: methodHeader) ifTrue: [1 << 17] ifFalse: [0])
         + ((oldInterpreter methodHeaderHasPrimitive: methodHeader) ifTrue: [1 << 16] ifFalse: [0])
         + (oldHeap literalCountOfMethodHeader: methodHeader)!

----- Method: SpurBootstrap>>defineKnownClassIndices (in category 'class indices') -----
defineKnownClassIndices
        "The classTable is laid out
                - to make it easy to map immediates to classes; the tag pattern of an immediate is its class index.
                  hence there are two entries for SmallInteger
                - to assign small indices to well-known classes such as Array, Message et al
                - to leave plenty of room for new known classes; hence the first page contains only well-known classes
                - to enable overlaps and avoid conflicts with indices in the specialObjectsArray (?really? eem)
                - to provide a WeakArray pun for the pages of the table itself so that these do not show up as instances of WeakArray"
        | classMethodContext classBlockClosure classMessage "no api method for these" |
        classMessage := oldHeap splObj: (VMObjectIndices bindingOf: #ClassMessage) value.
        classMethodContext := oldHeap splObj: (VMObjectIndices bindingOf: #ClassMethodContext) value.
        classBlockClosure := oldHeap splObj: (VMObjectIndices bindingOf: #ClassBlockClosure) value.
        "c.f. SpurMemoryManager class>>intializeCompactClassIndices".
        classToIndex keysDo:
                [:oldClass|
                self assert: (oldInterpreter addressCouldBeClassObj: oldClass)].
        classToIndex
                at: oldHeap classSmallInteger put: 1; "N.B. must fill-in index 3 manually"
                at: oldHeap classCharacter put: 2;
                "at: oldHeap classSmallInteger put: 3" "N.B. must fill-in index 3 manually"
                "leave room for up to 15 tagged classes"
                "leave room for up to 16 puns"
                at: oldHeap classLargeNegativeInteger put: 32;
                at: oldHeap classLargePositiveInteger put: 33;
                at: oldHeap classFloat put: 34;

                at: "oldHeap" classMessage put: 35;
                at: "oldHeap" classMethodContext put: (classMethodContextIndex := 36);
                at: "oldHeap" classBlockClosure put: (classBlockClosureIndex := 37);

                at: oldHeap classSemaphore put: 48;
                "at: oldHeap classMutex put: 49; see below"

                at: oldHeap classByteArray put: 50;
                at: oldHeap classArray put: 51;
                at: oldHeap classString put: 52;
                at: oldHeap classBitmap put: 53;
                at: oldHeap classPoint put: 54.

        {{oldHeap classMutex. 49}.
         {oldHeap classExternalAddress. 128}.
         {oldHeap classExternalData. 129}.
         {oldHeap classExternalFunction. 130}.
         {oldHeap classExternalLibrary. 131}.
         {oldHeap classExternalStructure. 132}.
         {oldHeap classAlien. 133}.
         {oldHeap classUnsafeAlien. 134}}
                do: [:pair|
                        [:oop :index|
                        oop ~= oldHeap nilObject ifTrue:
                                [classToIndex at: oop put: index]] valueWithArguments: pair].

        classToIndex keysDo:
                [:oldClass|
                self assert: (oldInterpreter addressCouldBeClassObj: oldClass)]!

----- Method: SpurBootstrap>>fileOutPrototypesFor: (in category 'public access') -----
fileOutPrototypesFor: imageTypeOrArrayOfTypes
        "SpurBootstrap new fileOutPrototypesFor: 'squeak'"
        | internalStream |
        imageTypes := imageTypeOrArrayOfTypes isString
                                                ifTrue: [{imageTypeOrArrayOfTypes}]
                                                ifFalse: [imageTypeOrArrayOfTypes asArray].
        internalStream := WriteStream on: (String new: 1000).
        internalStream header; timeStamp.
        self prototypeClassNameMetaSelectorMethodDo:
                [:className :isMeta :selector :method| | classNameString class category preamble source |
                class := Smalltalk classNamed: className.
                isMeta
                        ifTrue: [class := class class. classNameString := className, ' class']
                        ifFalse: [classNameString := className].
                (method pragmaAt: #remove)
                        ifNil:
                                [category := class ifNotNil: [class organization categoryOfElement: selector].
                                 (category notNil and: [category first = $*]) ifTrue:
                                        [category := nil].
                                 category ifNil:
                                        [category := self class categoryForClass: className meta: isMeta selector: selector].
                                preamble := classNameString, ' methodsFor: ' , category asString printString, ' stamp: ''', method timeStamp, ''''.
                                internalStream nextPut: $!!; nextChunkPut: preamble; cr.
                                source := method getSourceFromFile asString.
                                source := source copyFrom: (source indexOfSubCollection: 'PROTOTYPE') + 9 to: source size.
                                (self selectorForPrototypeMethod: method) isBinary ifTrue:
                                        [source := (self selectorForPrototypeMethod: method), (source copyFrom: (source indexOf: Character space) to: source size)].
                                internalStream nextChunkPut: source; space; nextPut: $!!; cr; cr]
                        ifNotNil:
                                [source := classNameString, ' removeSelector: ', selector storeString.
                                 internalStream nextChunkPut: source; cr; cr]].
        internalStream trailer.

        FileStream
                writeSourceCodeFrom: internalStream
                baseName: ('SpurBootstrapPrototypes-', (imageTypes fold: [:a :b| a, '-', b]) replaceAll: Character space with: $_)
                isSt: true
                useHtml: false!

----- Method: SpurBootstrap>>fillInClassTable (in category 'bootstrap image') -----
fillInClassTable
        | firstPage maxIndex |
        maxIndex := 0.
        classToIndex keysAndValuesDo:
                [:oldClass :index| | newClass page |
                maxIndex := maxIndex max: index.
                newClass := map at: oldClass.
                self assert: (newHeap isPointersNonImm: newClass).
                newHeap setHashBitsOf: newClass to: index.
                page := newHeap
                                        fetchPointer: index >> newHeap classTableMajorIndexShift
                                        ofObject: newHeap classTableRootObj.
                newHeap
                        storePointer: (index bitAnd: newHeap classTableMinorIndexMask)
                        ofObject: page
                        withValue: newClass.
                self assert: (newHeap classAtIndex: index) = newClass].
        firstPage := newHeap
                                        fetchPointer: 0
                                        ofObject: newHeap classTableRootObj.
        newHeap
                storePointer: 1
                        ofObject: firstPage
                                withValue: (map at: oldHeap classSmallInteger);
                storePointer: 2
                        ofObject: firstPage
                                withValue: (map at: oldHeap classCharacter);
                storePointer: 3
                        ofObject: firstPage
                                withValue: (map at: oldHeap classSmallInteger);
                storePointer: newHeap arrayClassIndexPun
                        ofObject: firstPage
                                withValue: (map at: oldHeap classArray);
                storePointer: newHeap arrayClassIndexPun
                        ofObject: firstPage
                                withValue: (map at: oldHeap classArray).

        newHeap classTableIndex: maxIndex!

----- Method: SpurBootstrap>>fillInCompiledMethod:from: (in category 'bootstrap image') -----
fillInCompiledMethod: newObj from: oldObj
        | firstByteIndex primIndex |
        self fillInPointerObject: newObj from: oldObj.
        "Now convert the CompiledMethod's format.  First write the header in the new format"
        newHeap
                storePointerUnchecked: 0
                ofObject: newObj
                withValue: (newHeap integerObjectOf: (self convertOldMethodHeader: (oldHeap fetchPointer: 0 ofObject: oldObj))).
        "Then if necessary prepend the callPrimitive: bytecode"
        (primIndex := oldInterpreter primitiveIndexOf: oldObj) > 0
                ifTrue:
                        [firstByteIndex := oldHeap lastPointerOf: oldObj.
                         newHeap
                                storeByte: firstByteIndex + 0 ofObject: newObj withValue: 139;
                                storeByte: firstByteIndex + 1 ofObject: newObj withValue: (primIndex bitAnd: 255);
                                storeByte: firstByteIndex + 2 ofObject: newObj withValue: (primIndex bitShift: -8).
                         firstByteIndex to: (oldHeap numBytesOfBytes: oldObj) - 1 do:
                                [:i|
                                newHeap storeByte: i + 3 ofObject: newObj withValue: (oldHeap fetchByte: i ofObject: oldObj)]]
                ifFalse:
                        [(oldHeap lastPointerOf: oldObj) / oldHeap wordSize to: (oldHeap numSlotsOf: oldObj) - 1 do:
                                [:i|
                                newHeap storeLong32: i ofObject: newObj withValue: (oldHeap fetchLong32: i ofObject: oldObj)]]!

----- Method: SpurBootstrap>>fillInObjects (in category 'bootstrap image') -----
fillInObjects
        oldHeap allObjectsDo:
                [:oldObj|
                (map at: oldObj ifAbsent: nil) ifNotNil:
                        [:newObj| | format classIndex |
                        format := newHeap formatOf: newObj.
                        (newHeap isPointersFormat: format)
                                ifTrue:
                                        [((newHeap isIndexableFormat: format)
                                                and: [(classIndex := newHeap classIndexOf: newObj) <= classBlockClosureIndex
                                                and: [classIndex >= classMethodContextIndex]])
                                                ifTrue: [self fillInPointerObjectWithPC: newObj from: oldObj]
                                                ifFalse: [self fillInPointerObject: newObj from: oldObj]]
                                ifFalse:
                                        [(newHeap isCompiledMethodFormat: format)
                                                ifTrue: [self fillInCompiledMethod: newObj from: oldObj]
                                                ifFalse: [self fillInBitsObject: newObj from: oldObj]]]]!

----- Method: SpurBootstrap>>fillInPointerObject:from: (in category 'bootstrap image') -----
fillInPointerObject: newObj from: oldObj
        "Fill-in a newObj with appropriately mapped contents from oldObj.
         Filter-out the character table and the compact classes array.
         Map character objects to immediate characters."
        0 to: (oldHeap lastPointerOf: oldObj) / oldHeap wordSize - 1 do:
                [:i| | oldValue newValue |
                oldValue := oldHeap fetchPointer: i ofObject: oldObj.
                newValue := (oldHeap isIntegerObject: oldValue)
                                                ifTrue: [oldValue]
                                                ifFalse:
                                                        [map at: oldValue ifAbsent:
                                                                [(oldValue = oldHeap characterTable
                                                                  or: [oldValue = (oldHeap splObj: CompactClasses)])
                                                                        ifTrue: [newHeap nilObject]
                                                                        ifFalse:
                                                                                [self assert: (oldHeap fetchClassOfNonImm: oldValue) = oldHeap classCharacter.
                                                                                 newHeap characterObjectOf:
                                                                                        (oldHeap integerValueOf:
                                                                                                (oldHeap fetchPointer: CharacterValueIndex ofObject: oldValue))]]].
                newHeap
                        storePointerUnchecked: i
                        ofObject: newObj
                        withValue: newValue].
        (self isOldObjABehavior: oldObj) ifTrue:
                [self mapOldBehavior: oldObj toNewBehavior: newObj]!

----- Method: SpurBootstrap>>fillInPointerObjectWithPC:from: (in category 'bootstrap image') -----
fillInPointerObjectWithPC: newObj from: oldObj
        "Fill-in a newObj with appropriately mapped contents from oldObj.
         If the object has a pc and its method has a primitive, increment the
         pc by the size of the callPrimitive: bytecode."
        | method |
        self fillInPointerObject: newObj from: oldObj.
        (newHeap classIndexOf: newObj) = classBlockClosureIndex ifTrue:
                [method := oldHeap
                                                fetchPointer: MethodIndex
                                                ofObject: (oldHeap
                                                                        fetchPointer: ClosureOuterContextIndex
                                                                        ofObject: oldObj).
                 (oldInterpreter primitiveIndexOf: method) > 0 ifTrue:
                        [self incrementPCField: ClosureStartPCIndex ofObject: newObj by: 3]].
        (newHeap classIndexOf: newObj) = classMethodContextIndex ifTrue:
                [method := oldHeap
                                                fetchPointer: MethodIndex
                                                ofObject: oldObj.
                 (method ~= oldHeap nilObject
                  and: [(oldInterpreter primitiveIndexOf: method) > 0]) ifTrue:
                        [self incrementPCField: InstructionPointerIndex ofObject: newObj by: 3]].!

----- Method: SpurBootstrap>>findClassNamed: (in category 'bootstrap methods') -----
findClassNamed: symbolOop
        oldHeap allObjectsDo:
                [:o|
                ((oldHeap isPointersNonImm: o)
                 and: [(oldInterpreter addressCouldBeClassObj: o)
                 and: [(oldHeap fetchPointer: oldInterpreter classNameIndex ofObject: o) = symbolOop]]) ifTrue:
                        [^o]].
        ^nil!

----- Method: SpurBootstrap>>findLiteral:inClass: (in category 'bootstrap methods') -----
findLiteral: aLiteral inClass: classOop
        | bindingOrNil |
        aLiteral isString ifTrue:
                [^self stringFor: aLiteral].
        aLiteral isFloat ifTrue:
                [^oldHeap floatObjectOf: aLiteral].
        aLiteral isArray ifTrue:
                [^self cloneArrayLiteral: aLiteral].
        aLiteral isCharacter ifTrue:
                [^oldHeap characterObjectOf: aLiteral asciiValue].
        self assert: aLiteral isVariableBinding.
        bindingOrNil := self interpreter: oldInterpreter
                                                object: classOop
                                                perform: (self findSymbol: #bindingOf:)
                                                withArguments: {self findSymbol: aLiteral key}.
        bindingOrNil ~= oldHeap nilObject ifTrue:
                [^bindingOrNil].
        self error: 'couldn''t find literal ', aLiteral printString!

----- Method: SpurBootstrap>>findRequiredGlobals (in category 'bootstrap image') -----
findRequiredGlobals
        "Look for the necessary gobal bindings in the prototype methods in the old image.
         This has to be done early by sending bindingOf: to Smalltalk.  Collect the class
         hierarchy of all prototypes that access inst vars (non-local prototypes) to check
         their shapes.  Also find out Metaclass, needed for identifying classes."
        | globals ourMethodClasses classVars bindingOfSym |
        globals := Set new.
        ourMethodClasses := Set new.
        classVars := Dictionary new.
        self prototypeClassNameMetaSelectorMethodDo:
                [:c :m :s :method| | allNonMetaSupers |
                (Smalltalk classNamed: c) ifNotNil:
                        [:nonMetaClass|
                        allNonMetaSupers := nonMetaClass withAllSuperclasses.
                        (method methodClass includesBehavior: SpurBootstrapPrototypes) ifFalse:
                                [ourMethodClasses addAll: allNonMetaSupers.
                                 globals addAll: (allNonMetaSupers collect: [:sc| sc binding])].
                        method literals do:
                                [:l|
                                (l isVariableBinding
                                 and: [l key isSymbol
                                 and: [SpurBootstrapPrototypes withAllSubclasses noneSatisfy: [:sbpc| sbpc name == l key]]]) ifTrue:
                                        [((Smalltalk bindingOf: l key) == l
                                          or: [(Undeclared bindingOf: l key) == l])
                                                ifTrue: [globals add: l]
                                                ifFalse:
                                                        [self assert: (nonMetaClass bindingOf: l key) == l.
                                                        classVars at: l put: nonMetaClass]]]]].
        globals add: Compiler binding. "For potential reshaping in checkReshapeOf:"
        bindingOfSym := self findSymbol: #bindingOf:.
        self withExecutableInterpreter: oldInterpreter
                do: [| toBeAdded |
                        globals do:
                                [:global| | bindingOop |
                                (self findSymbol: global key) ifNotNil:
                                        [:symbolOop|
                                        bindingOop := self interpreter: oldInterpreter
                                                                                object: (oldHeap splObj: 8) "Smalltalk"
                                                                                perform: bindingOfSym
                                                                                withArguments: {self findSymbol: global key}.
                                        bindingOop ~= oldHeap nilObject ifTrue:
                                                [literalMap at: global put: bindingOop]]].
                         toBeAdded := Dictionary new.
                         classVars keysAndValuesDo:
                                [:var :class| | val |
                                (self findSymbol: var key) "New class inst vars may not yet be interned."
                                        ifNil: [toBeAdded at: var put: class]
                                        ifNotNil:
                                                [:varName|
                                                val := self interpreter: oldInterpreter
                                                                        object: (self oldClassOopFor: class)
                                                                        perform: bindingOfSym
                                                                        withArguments: {varName}.
                                                val ~= oldHeap nilObject
                                                        ifTrue: [literalMap at: var put: val]
                                                        ifFalse: [toBeAdded at: var put: class]]].
                        "May have to redefine to add missing inst vars and/or add any missing class vars."
                        self checkReshapeOf: ourMethodClasses.
                        self addMissingClassVars: toBeAdded]!

----- Method: SpurBootstrap>>findSymbol: (in category 'bootstrap methods') -----
findSymbol: aString
        "Find the Symbol equal to aString in oldHeap."
        | symbolClass |
        (literalMap at: aString ifAbsent: nil) ifNotNil:
                [:oop| ^oop].
        symbolClass := self symbolClass.
        oldHeap allObjectsDo:
                [:obj|
                (symbolClass = (oldHeap fetchClassOfNonImm: obj)
                 and: [(oldHeap numBytesOf: obj) = aString size
                 and: [aString = (oldHeap stringOf: obj)]]) ifTrue:
                        [aString isSymbol ifTrue:
                                [literalMap at: aString asSymbol put: obj].
                         ^obj]].
        Transcript cr; nextPutAll: 'Warning, could not find '; store: aString; flush.
        ^nil!

----- Method: SpurBootstrap>>firstOrdinaryClassIndex (in category 'class indices') -----
firstOrdinaryClassIndex
        ^newHeap classTablePageSize!

----- Method: SpurBootstrap>>followForwardingPointers (in category 'bootstrap image') -----
followForwardingPointers
        newHeap allObjectsDo:
                [:o|
                (newHeap isForwarded: o) ifFalse:
                        [0 to: (newHeap numPointerSlotsOf: o) - 1 do:
                                [:i| | field |
                                field := newHeap fetchPointer: i ofObject: o.
                                (newHeap isOopForwarded: field) ifTrue:
                                        [newHeap
                                                storePointer: i
                                                ofObject: o
                                                withValue: (newHeap followForwarded: field)]]]]!

----- Method: SpurBootstrap>>freeForwarders (in category 'bootstrap image') -----
freeForwarders
        "Check that all forwarders have been followed.  Then free them."
        | numForwarders numFreed |
        numForwarders := numFreed := 0.
        newHeap allObjectsDo:
                [:o|
                (newHeap isForwarded: o)
                        ifTrue: [numForwarders := numForwarders + 1]
                        ifFalse:
                                [0 to: (newHeap numPointerSlotsOf: o) - 1 do:
                                        [:i|
                                        self assert: (newHeap isOopForwarded: (newHeap fetchPointer: i ofObject: o)) not]]].
        Transcript ensureCr;  nextPutAll: 'freeing '; print: numForwarders; nextPutAll: ' forwarders'; cr; flush.
        newHeap allObjectsDo:
                [:o|
                (newHeap isForwarded: o) ifTrue:
                        [numFreed := numFreed + 1.
                         newHeap freeObject: o]].
        self assert: numFreed = numForwarders!

----- Method: SpurBootstrap>>headerForOldMethodHeader: (in category 'bootstrap image') -----
headerForOldMethodHeader: methodHeaderOop
        ^self isOnSpur
                ifTrue: [self convertOldMethodHeader: methodHeaderOop]
                ifFalse: [oldHeap integerValueOf: methodHeaderOop]!

----- Method: SpurBootstrap>>imageTypes: (in category 'bootstrap image') -----
imageTypes: anArray
        imageTypes := anArray!

----- Method: SpurBootstrap>>incrementPCField:ofObject:by: (in category 'bootstrap image') -----
incrementPCField: fieldIndex ofObject: newObj by: n
        | value |
        value := newHeap fetchPointer: fieldIndex ofObject: newObj.
        (newHeap isIntegerObject: value)
                ifTrue:
                        [newHeap
                                storePointerUnchecked: fieldIndex
                                ofObject: newObj
                                withValue: (newHeap integerObjectOf: n + (newHeap integerValueOf: value))]
                ifFalse:
                        [self assert: value = newHeap nilObject]!

----- Method: SpurBootstrap>>indexOfSelector:in: (in category 'bootstrap methods') -----
indexOfSelector: selectorOop in: methodDict
        SelectorStart to: (oldHeap numSlotsOf: methodDict) - 1 do:
                [:i|
                (oldHeap fetchPointer: i ofObject: methodDict) = selectorOop ifTrue:
                        [^i]].
        self error: 'could not find selector in method dict'!

----- Method: SpurBootstrap>>initMaps (in category 'initialize-release') -----
initMaps
        map := Dictionary new: oldHeap memory size // 4.
        reverseMap := Dictionary new: oldHeap memory size // 4.
        classToIndex := Dictionary new: 1024.
        literalMap := IdentityDictionary new.
        methodClasses := Set new.
        installedPrototypes := Set new.
        installedMethodOops := Set new.
        classMetaclass := nil!

----- Method: SpurBootstrap>>initialize (in category 'initialize-release') -----
initialize
        super initialize.
        imageTypes := {'squeak'}. "By default, image is Squeak (so Eliot does not kick me :P)"!

----- Method: SpurBootstrap>>initializeClasses (in category 'bootstrap image') -----
initializeClasses
        toBeInitialized ifNil: [^self].
        self withExecutableInterpreter: oldInterpreter
                do: [toBeInitialized do:
                                [:class|
                                self interpreter: oldInterpreter
                                        object: (self oldClassOopFor: class)
                                        perform: (self findSymbol: #initialize)
                                        withArguments: #()]]!

----- Method: SpurBootstrap>>installModifiedMethods (in category 'bootstrap methods') -----
installModifiedMethods
        "Install all the methods in the class-side method prototypes protocol in the relevant classes
         in the new image.  First use the simulator to get the image to intern all symbols and add
         dummy methods under new selectors.  With that done we can manually replace the relevant
         methods with the prototypes, mapping selectors and global variables as required."
        self withExecutableInterpreter: oldInterpreter
                do: [self internAllSymbols.
                         self addNewMethods.
                         self removeMethods.
                         self replaceMethods.
                         self modifyCharacterMethods]!

----- Method: SpurBootstrap>>installableMethodFor:selector:className:isMeta: (in category 'bootstrap methods') -----
installableMethodFor: aCompiledMethod selector: selector className: className isMeta: isMeta
        "Create a sourceless method to install in the bootstrapped image.  It will allow the
         bootstrap to limp along until the relevant transformed Monticello package is loaded."
        | compiledMethodClass methodClassBinding methodClass sourcelessMethod bytes newMethod delta initialPC |
        compiledMethodClass := self findClassNamed: (self findSymbol: #CompiledMethod).
        methodClassBinding := self methodClassBindingForClassName: className isMeta: isMeta.
        methodClass := oldHeap fetchPointer: ValueIndex ofObject: methodClassBinding.
        "the prototypes have source pointers.  the Character methods to be replaced don't."
        sourcelessMethod := aCompiledMethod trailer hasSourcePointer
                                                        ifTrue: [aCompiledMethod copyWithTempsFromMethodNode: aCompiledMethod methodNode]
                                                        ifFalse: [aCompiledMethod].
        initialPC := sourcelessMethod initialPC.
        bytes := sourcelessMethod size - initialPC + 1.
        "Ugh, this is complicated.  We could be running on Spur with the new method format
         or on non-Spur with the old format.  Make both work."
        delta := (sourcelessMethod primitive > 0
                         and: [(sourcelessMethod at: initialPC) = sourcelessMethod encoderClass callPrimitiveCode])
                                ifTrue: [3]
                                ifFalse: [0].
        newMethod := self
                                        interpreter: oldInterpreter
                                        object: compiledMethodClass
                                        perform: (self findSymbol: #newMethod:header:)
                                        withArguments: { oldHeap integerObjectOf: bytes - delta.
                                                                           oldHeap integerObjectOf: (self oldFormatHeaderFor: sourcelessMethod) }.
        1 to: sourcelessMethod numLiterals - 2 do:
                [:i| | literal oop |
                literal := sourcelessMethod literalAt: i.
                oop := (literal isLiteral or: [literal isVariableBinding])
                                        ifTrue:
                                                [literal isInteger
                                                        ifTrue: [oldInterpreter signed64BitIntegerFor: literal]
                                                        ifFalse: [literalMap
                                                                                at: literal
                                                                                ifAbsent: [self findLiteral: literal
                                                                                                                inClass: methodClass]]]
                                        ifFalse: "should be a VMObjectProxy"
                                                [literal oop].
                oldHeap storePointer: i ofObject: newMethod withValue: oop].
        oldHeap
                storePointer: sourcelessMethod numLiterals - 1
                ofObject: newMethod
                withValue: (selector isSymbol
                                                ifTrue: [self findSymbol: selector]
                                                ifFalse: [selector oop]);
                storePointer: sourcelessMethod numLiterals
                ofObject: newMethod
                withValue: methodClassBinding.
        initialPC to: sourcelessMethod size - delta do:
                [:i|
                oldHeap storeByte: i - 1 ofObject: newMethod withValue: (sourcelessMethod byteAt: i + delta)].
        installedMethodOops add: newMethod.
        ^newMethod!

----- Method: SpurBootstrap>>internAllSymbols (in category 'bootstrap methods') -----
internAllSymbols
        "Ensure that all symbols in the method prototypes are interned so that later we can install them.
         Enter them into the map, this system's symbol -> oldHeap's version.
         Do this by interpreting Symbol intern: 'aSymbol' for each symbol."
        | internSym all symbolClass |
        internSym := self findSymbol: #intern:.
        symbolClass := self symbolClass.
        all := self allPrototypeMethodSymbols.
        oldHeap allObjectsDo:
                [:objOop| | sz |
                symbolClass = (oldHeap fetchClassOfNonImm: objOop) ifTrue:
                        [sz := oldHeap numBytesOf: objOop.
                         (all detect: [:sym| sym size = sz and: [sym = (oldHeap stringOf: objOop)]]
                                ifNone: nil) ifNotNil:
                                        [:sym|
                                        literalMap at: sym put: objOop.
                                        all remove: sym]]].
        all do: [:sym|
                (self findSymbol: sym)
                        ifNotNil: [:imageSym| literalMap at: sym put: imageSym]
                        ifNil:[Transcript cr; nextPutAll: 'interning '; nextPutAll: sym; flush.
                                "Interpret Symbol intern: sym to ... intern it :-)"
                                literalMap
                                        at: sym
                                        put: (self interpreter: oldInterpreter
                                                        object: self symbolClass
                                                        perform: internSym
                                                        withArguments: {self stringFor: sym})]].
        literalMap keysAndValuesDo:
                [:symOrGlobal :imageSymOrGlobal|
                symOrGlobal isSymbol ifTrue:
                        [self assert: symOrGlobal = (oldHeap stringOf: imageSymOrGlobal)]]!

----- Method: SpurBootstrap>>isOldObjABehavior: (in category 'bootstrap image') -----
isOldObjABehavior: oldObj
        | oldObjClass |
        ^(classToIndex includesKey: oldObj)
        or: [(oldObjClass := oldHeap fetchClassOfNonImm: oldObj) = self classMetaclass
        or: [(oldHeap fetchClassOfNonImm: oldObjClass) = classMetaclass]]!

----- Method: SpurBootstrap>>isOnSpur (in category 'testing') -----
isOnSpur
        ^$c class instSize = 0!

----- Method: SpurBootstrap>>launch (in category 'testing') -----
launch
        self launch: newHeap
                simulatorClass: StackInterpreterSimulator
                headerFlags: oldInterpreter getImageHeaderFlags!

----- Method: SpurBootstrap>>launch:simulatorClass:headerFlags: (in category 'testing') -----
launch: heap simulatorClass: simulatorClass headerFlags: headerFlags
        | sim methodCacheSize |
        sim := simulatorClass onObjectMemory: heap.
        heap coInterpreter: sim.
        (sim class allInstVarNames includes: 'cogCodeSize')
                ifTrue:
                        [sim initializeInterpreter: 0.
                         methodCacheSize := sim methodCache size * heap wordSize.
                         sim instVarNamed: 'heapBase' put: heap startOfMemory;
                                instVarNamed: 'numStackPages' put: 8;
                                instVarNamed: 'cogCodeSize' put: 1024*1024;
                                moveMethodCacheToMemoryAt: sim cogCodeSize + sim computeStackZoneSize;
                                movePrimTraceLogToMemoryAt: sim cogCodeSize + sim computeStackZoneSize + methodCacheSize;
                                "sendTrace: 1+ 2 + 8 + 16;"
                          initializeCodeGenerator]
                ifFalse:
                        [sim initializeInterpreter: 0].
        heap
                initializeNewSpaceVariables;
                bootstrapping: false;
                assimilateNewSegment: (heap segmentManager segments at: 0).
        sim
                setImageHeaderFlagsFrom: headerFlags;
                imageName: ImageName;
                flushExternalPrimitives;
                openAsMorph;
                transcript: Transcript. "deep copy copies this"
        "sim
                instVarNamed: 'printSends' put: true;
                instVarNamed: 'printReturns' put: true;
                instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal." "for now"
        heap
                setCheckForLeaks: 0;
                runLeakCheckerForFullGC.

        sim halt; run!

----- Method: SpurBootstrap>>launchSaved (in category 'testing') -----
launchSaved
        self launch: TransformedImage veryDeepCopy
                simulatorClass: StackInterpreterSimulator
                headerFlags: ImageHeaderFlags!

----- Method: SpurBootstrap>>launchSavedWithJIT (in category 'testing') -----
launchSavedWithJIT
        self launch: (self coHeapFrom: TransformedImage veryDeepCopy)
                simulatorClass: CogVMSimulator
                headerFlags: ImageHeaderFlags!

----- Method: SpurBootstrap>>mapOldBehavior:toNewBehavior: (in category 'bootstrap image') -----
mapOldBehavior: oldObj toNewBehavior: newObj
        "Map the old format inst var's value to the new value.
         In addition, for Character, make it immediate and remove its instance variable."
        newHeap
                storePointerUnchecked: InstanceSpecificationIndex
                ofObject: newObj
                withValue: (self newClassFormatFor: oldObj).
        oldObj = oldHeap classCharacter ifTrue:
                [InstanceSpecificationIndex + 1 to: (oldHeap numSlotsOf: oldObj) do:
                        [:i| | var field |
                        var := oldHeap fetchPointer: i ofObject: oldObj.
                        ((oldHeap fetchClassOf: var) = oldHeap classArray
                         and: [(oldHeap numSlotsOf: var) = 1
                         and: [field := oldHeap fetchPointer: 0 ofObject: var.
                                (oldHeap fetchClassOf: field) = oldHeap classString
                         and: [(oldHeap lengthOf: field) = 5
                         and: [(oldHeap str: 'value'  n: (oldHeap firstIndexableField: field) cmp: 5) = 0]]]]) ifTrue:
                                [newHeap
                                        storePointerUnchecked: i
                                        ofObject: newObj
                                        withValue: newHeap nilObject.
                                 ^self]]]!

----- Method: SpurBootstrap>>measureNewHeapPostInitPostBootstrap (in category 'stats') -----
measureNewHeapPostInitPostBootstrap
        | savedEndOfMemory |
        "need to hack around the fact that newHeap isn't all there yet.
         In particular, it has no freeList so can't free space from
         freeOldSpaceStart to endOfMemory to make oldSpace enumerable."
        newHeapNumObjs := 0.
        savedEndOfMemory := newHeap endOfMemory.
        newHeap setEndOfMemory: newHeap freeOldSpaceStart.
        newHeap allObjectsDo: [:o| newHeapNumObjs := newHeapNumObjs + 1].
        newHeap setEndOfMemory: savedEndOfMemory!

----- Method: SpurBootstrap>>measureOldHeapPostGC (in category 'stats') -----
measureOldHeapPostGC
        oldHeapSize := oldHeap freeStart.
        oldHeapNumObjs := 0.
        oldHeap allObjectsDo: [:o| oldHeapNumObjs := oldHeapNumObjs + 1]!

----- Method: SpurBootstrap>>methodClassBindingForClassName:isMeta: (in category 'bootstrap methods') -----
methodClassBindingForClassName: classNameSymbol isMeta: isMeta
        | class |
        class := self findClassNamed: (literalMap at: classNameSymbol).
        isMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
        ^self interpreter: oldInterpreter
                object: class
                perform: (self findSymbol: #binding)
                withArguments: #()!

----- Method: SpurBootstrap>>modifyCharacterMethods (in category 'bootstrap methods') -----
modifyCharacterMethods
        | cc md mda |
        cc := oldHeap classCharacter.
        md := oldHeap fetchPointer: MethodDictionaryIndex ofObject: cc.
        mda := oldHeap fetchPointer: MethodArrayIndex ofObject: md..
        0 to: (oldHeap numSlotsOf: mda) - 1 do:
                [:i| | method |
                method := oldHeap fetchPointer: i ofObject: mda.
                method ~= oldHeap nilObject ifTrue:
                        [(self replacementForCharacterMethod: method) ifNotNil:
                                [:replacement|
                                Transcript
                                        cr;
                                        nextPutAll: 'replacing Character>>#';
                                        nextPutAll: (oldHeap stringOf: (oldHeap fetchPointer: i + SelectorStart ofObject: md));
                                        flush.
                                oldHeap
                                        storePointer: i
                                        ofObject: mda
                                        withValue: replacement]]]!

----- Method: SpurBootstrap>>newClassFormatFor: (in category 'bootstrap image') -----
newClassFormatFor: oldClassObj
        "OLD: <2 bits=instSize//64><5 bits=cClass><4 bits=instSpec><6 bits=instSize\\64><1 bit=0>
         NEW: <5 bits inst spec><16 bits inst size>"
        | oldFormat instSize newInstSpec |
        ((oldInterpreter classNameOf: oldClassObj Is: 'SmallInteger')
         or: [(oldInterpreter classNameOf: oldClassObj Is: 'Character')
         or: [oldInterpreter classNameOf: oldClassObj Is: 'SmallFloat64']]) ifTrue:
                [^newHeap integerObjectOf: newHeap instSpecForImmediateClasses << 16].
        oldFormat := oldHeap formatOfClass: oldClassObj. "N.B. SmallInteger with tag bit cleared"
        oldFormat := oldFormat >> 1.
        instSize := ((oldFormat bitShift: -10) bitAnd: 16rC0) + ((oldFormat bitShift: -1) bitAnd: 16r3F) - 1.
        newInstSpec := #(0 1 2 3 4 nil 10 9 16 16 16 16 24 24 24 24) at: ((oldFormat bitShift: -7) bitAnd: 16rF) + 1.
        ^newHeap integerObjectOf: newInstSpec << 16 + instSize!

----- Method: SpurBootstrap>>newFormatFor:numBytes: (in category 'bootstrap image') -----
newFormatFor: oldObj numBytes: numBytesIfBits
        "OLD:
         0 no fields
         1 fixed fields only (all containing pointers)
         2 indexable fields only (all containing pointers)
         3 both fixed and indexable fields (all containing pointers)
         4 both fixed and indexable weak fields (all containing pointers).

         5 unused
         6 indexable word fields only (no pointers)
         7 indexable long (64-bit) fields (only in 64-bit images)
 
         8-11 indexable byte fields only (no pointers) (low 2 bits are low 2 bits of size)
         12-15 compiled methods:
             # of literal oops specified in method header,
             followed by indexable bytes (same interpretation of low 2 bits as above)"

        "NEW:
         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 = reserved
         7 = forwarder format (also immediate class format)
         9          64-bit indexable
         10 - 11 32-bit indexable
         12 - 15 16-bit indexable
         16 - 23 byte indexable
         24 - 31 compiled method"
        | oldFormat |
        oldFormat := oldHeap formatOf: oldObj.
        oldFormat <= 4 ifTrue:
                [^oldFormat].
        oldFormat >= 12 ifTrue: "CompiledMethod"
                [^24 + (self wordSize - numBytesIfBits bitAnd: self wordSizeMask)].
        oldFormat >= 8 ifTrue: "ByteArray et al"
                [^16 + (self wordSize - numBytesIfBits bitAnd: self wordSizeMask)].
        oldFormat = 6 ifTrue: "32-bit indexable"
                [^10 + (numBytesIfBits bitAnd: self wordSizeMask) sign].
        oldFormat = 7 ifTrue: "64-bit indexable"
                [^9].
        self error: 'illegal old format'!

----- Method: SpurBootstrap>>oldClassOopFor: (in category 'bootstrap image') -----
oldClassOopFor: aClass
        ^oldHeap fetchPointer: ValueIndex ofObject: (literalMap at: aClass binding).!

----- Method: SpurBootstrap>>oldFormatHeaderFor: (in category 'bootstrap methods') -----
oldFormatHeaderFor: method
        | primBits primitive |
        primitive := method primitive.
        primBits := primitive <= 16r1FF
                                        ifTrue: [primitive]
                                        ifFalse: [(primitive bitAnd: 16r1FF) + ((primitive bitAnd: 16r200) bitShift: 19)].
        ^(method numArgs bitShift: 24)
        + (method numTemps bitShift: 18)
        + (method frameSize > method class smallFrameSize ifTrue: [1 << 17] ifFalse: [0])
        + (method numLiterals bitShift: 9)
        + primBits!

----- Method: SpurBootstrap>>on: (in category 'initialize-release') -----
on: imageName
        StackInterpreter initializeWithOptions: Dictionary new.
        (oldInterpreter := StackInterpreterSimulator new)
                openOn: imageName extraMemory: 0;
                assertValidExecutionPointersAtEachStep: false.
        oldHeap := oldInterpreter objectMemory.
        newHeap := Spur32BitMMLESimulator new.
        newHeap
                allocateMemoryOfSize: (oldHeap youngStart * 3 / 2 roundUpTo: 1024 * 1024)
                newSpaceSize: 4 * 1024 * 1024
                stackSize: 16 * 1024
                codeSize: 0.
        newHeap setCheckForLeaks: 15 - 6. "don't check become; or newSpace; soooo many rehashes in bootstrap"
        newHeap bootstrapping: true.
        self initMaps!

----- Method: SpurBootstrap>>prototypeClassNameMetaSelectorMethodDo: (in category 'method prototypes') -----
prototypeClassNameMetaSelectorMethodDo: quaternaryBlock
        "Evaluate aBlock with class name, class is meta, method and selector.
         For now find methods in class-side category #'method prototypes'.
         Scheme could be extended to have different protocols for different
         Squeak/Pharo versions."
        self allMethodPrototypes do:
                [:methodArg| | method className isMeta |
                className := self classNameForPrototypeMethod: (method := methodArg).
                (isMeta := className endsWith: 'class') ifTrue:
                        [className := (className allButLast: 5) asSymbol].
                (method pragmaAt: #indirect) ifNotNil:
                        [method := (isMeta
                                                        ifTrue: [(Smalltalk classNamed: className) class]
                                                        ifFalse: [Smalltalk classNamed: className]) >> method selector].
                quaternaryBlock
                        value: className
                        value: isMeta
                        value: (self selectorForPrototypeMethod: method)
                        value: method]!

----- Method: SpurBootstrap>>recreateSpecialObjectsArray (in category 'bootstrap image') -----
recreateSpecialObjectsArray
        "This is tricky.  We want to recreate the specialObjectsArray according to
         the class side SmalltalkImagePROTOTYPErecreateSpecialObjectsArray.
         But that version destroys the CompactClassesArray upon which the V3
         image depends.  The bootstrap will get rid of it later.  So save it before
         the recreation and restore it."
        self withExecutableInterpreter: oldInterpreter
                do: [| compactClassesArray |
                        compactClassesArray := oldHeap splObj: CompactClasses.
                        self
                                interpreter: oldInterpreter
                                object: (oldHeap splObj: 8)
                                perform: (self findSymbol: #recreateSpecialObjectsArray)
                                withArguments: #().
                        oldHeap splObj: CompactClasses put: compactClassesArray]!

----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') -----
rehashImage
        "Rehash all collections in newHeap.
         Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags.
         Enumerate all objects, rehashing those whose class has a bit set in rehashFlags."
        | n sim rehashFlags dotDate rehashSym sizeSym |
        rehashSym := map at: (self findSymbol: #rehash).
        sizeSym := map at: (self findSymbol: #size).
        sim := StackInterpreterSimulator
                                onObjectMemory: newHeap
                                options: #(ObjectMemory #Spur32BitMemoryManager).
        sim
                setImageHeaderFlagsFrom: oldInterpreter getImageHeaderFlags;
                imageName: 'spur image';
                assertValidExecutionPointersAtEachStep: false..
        newHeap coInterpreter: sim.
        sim bootstrapping: true.
        sim initializeInterpreter: 0.
        sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal.
        (imageTypes includes: 'cuis') ifTrue:
                [newHeap scavenger growRememberedSet]. "Rehashing a 4.2 Cuis image overflows the 768 element high tide."
       
        sim redirectTranscriptToHost.

        newHeap
                setHashBitsOf: newHeap nilObject to: 1;
                setHashBitsOf: newHeap falseObject to: 2;
                setHashBitsOf: newHeap trueObject to: 3.

        rehashFlags := ByteArray new: newHeap numClassTablePages * newHeap classTablePageSize.
        n := 0.
        newHeap classTableObjectsDo:
                [:class| | classIndex |
                sim messageSelector: rehashSym.
                "Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self."
                ((sim lookupOrdinaryNoMNUEtcInClass: class) = 0
                 and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue:
                        [n := n + 1.
                         classIndex := newHeap rawHashBitsOf: class.
                         rehashFlags
                                at: classIndex >> 3 + 1
                                put: ((rehashFlags at: classIndex >> 3 + 1)
                                                bitOr: (1 << (classIndex bitAnd: 7)))]].
        Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush.
        dotDate := Time now asSeconds.
        n := 0.
        self withExecutableInterpreter: sim
                do: [sim setBreakSelector: 'error:'.
                         "don't rehash twice (actually without limit), so don't rehash any new objects created."
                         newHeap allExistingOldSpaceObjectsDo:
                                [:o| | classIndex |
                                classIndex := newHeap classIndexOf: o.
                                ((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue:
                                        [Time now asSeconds > dotDate ifTrue:
                                          [Transcript nextPut: $.; flush.
                                                 dotDate := Time now asSeconds].
                                         "2845 = n ifTrue: [self halt]."
                                         "Rehash an object if its size is > 0.
                                          Symbol implements rehash, but let's not waste time rehashing it; in Squeak
                                          up to 2013 symbols are kept in a set which will get reashed anyway..
                                          Don't rehash empty collections; they may be large for a reason and rehashing will shrink them."
                                         ((sim addressCouldBeClassObj: o)
                                           or: [(self interpreter: sim
                                                        object: o
                                                        perform: sizeSym
                                                        withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse:
                                                [self interpreter: sim
                                                        object: o
                                                        perform: rehashSym
                                                        withArguments: #()]]]]!

----- Method: SpurBootstrap>>removeMethods (in category 'bootstrap methods') -----
removeMethods
        "Get the simulator to remove any methods marked with <remove>."
        | removeSym |
        removeSym := self findSymbol: #removeSelectorSilently:.
        removeSym ifNil:
                [removeSym := self findSymbol: #removeSelector:].
        self prototypeClassNameMetaSelectorMethodDo:
                [:className :isMeta :selector :method| | class |
                (method pragmaAt: #remove) ifNotNil:
                        [(self findClassNamed: (literalMap at: className)) ifNotNil:
                                [:theClass|
                                 class := isMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass].
                                 Transcript
                                        cr;
                                        nextPutAll: 'removing ';
                                        nextPutAll: className;
                                        nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
                                        store: selector;
                                        flush.
                                 self interpreter: oldInterpreter
                                        object: class
                                        perform: removeSym
                                        withArguments: {literalMap at: selector}]]]!

----- Method: SpurBootstrap>>replaceMethods (in category 'bootstrap methods') -----
replaceMethods
        "Replace all the modified method prototypes."
        self allPrototypeClassNamesDo:
                [:sym :symIsMeta|
                (self findClassNamed: (literalMap at: sym))
                        ifNil: [Transcript
                                        cr;
                                        nextPutAll: 'not replacing any methods for ';
                                        nextPutAll: sym;
                                        nextPutAll: '; class not found in image';
                                        flush.]
                        ifNotNil:
                                [:theClass| | class |
                                class := symIsMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass].
                                self prototypeClassNameMetaSelectorMethodDo:
                                        [:className :isMeta :selector :method| | replacement methodDict index |
                                        (className = sym
                                         and: [symIsMeta = isMeta
                                         and: [(method pragmaAt: #remove) isNil]]) ifTrue:
                                                [(installedPrototypes includes: method selector) ifFalse:
                                                        ["probe method dictionary of the class for each method, installing a dummy if not found."
                                                        Transcript
                                                                cr;
                                                                nextPutAll: 'replacing ';
                                                                nextPutAll: className;
                                                                nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
                                                                store: selector;
                                                                flush.
                                                        replacement := self installableMethodFor: method
                                                                                                selector: selector
                                                                                                className: className
                                                                                                isMeta: isMeta.
                                                        methodDict := oldHeap fetchPointer: MethodDictionaryIndex ofObject: class.
                                                        index := self indexOfSelector: (literalMap at: selector) in: methodDict.
                                                        oldHeap
                                                                storePointer: index - SelectorStart
                                                                ofObject: (oldHeap fetchPointer: MethodArrayIndex ofObject: methodDict)
                                                                withValue: replacement.
                                                        installedPrototypes add: method selector]]]]]!

----- Method: SpurBootstrap>>replacementForCharacterMethod: (in category 'bootstrap methods') -----
replacementForCharacterMethod: characterMethodOop
        "Answer a replacement method for the argument if it refers
         to Character's old inst var value.  Otherwise answer nil."
        | proxy asIntegerProxy clone assembly newInsts newMethod |
        "(oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue:
                [self halt]."
        "Don't replace something already installed."
        (installedMethodOops includes: characterMethodOop) ifTrue:
                [^nil].
        proxy := VMCompiledMethodProxy new
                                for: characterMethodOop
                                coInterpreter: oldInterpreter
                                objectMemory: oldHeap.
        self assert: (oldHeap literalCountOf: characterMethodOop) = proxy numLiterals.
        clone := self cloneMethodProxy: proxy.
        self assert: proxy numLiterals = clone numLiterals.
        clone isReturnSpecial ifTrue:
                [^nil].
        "Quick methods accessing value should have been replaced.  The halt will fire if there
         is a missing prototype for such a method on the class side of SpurBootstrap.  The
         relevant Character prototypes there so far are Character>>asInteger, Character>>
         asciiValue, Character>>hash & Character>>identityHash.  Conceivably the bootstrap
         could be applied to an image that has others; hence the halt."
        clone isReturnField ifTrue: [self halt].
        clone hasInstVarRef ifFalse:
                [^nil].
        clone setSourcePointer: 0.
        asIntegerProxy := VMObjectProxy new
                                                        for: (literalMap at: #asInteger)
                                                        coInterpreter: oldInterpreter
                                                        objectMemory: oldHeap.
        assembly := BytecodeDisassembler new disassemble: clone.
        assembly literals: (assembly literals allButLast: 2), {asIntegerProxy}, (assembly literals last: 2).
                "Do this by looking for index of pushReceiverVariable: and replacing it by pushSelf, send asInteger"
        newInsts := (assembly instructions piecesCutWhere:
                                        [:msgOrLabelAssoc :nextInst|
                                         msgOrLabelAssoc isVariableBinding not
                                         and: [msgOrLabelAssoc selector == #pushReceiverVariable:]]) fold:
                                [:a :b|
                                 a allButLast,
                                 { Message selector: #pushReceiver.
                                        Message
                                                selector: #send:super:numArgs:
                                                arguments: {asIntegerProxy. false. 0}},
                                 b].
        assembly instructions: newInsts.
        newMethod := assembly assemble.
        self assert: clone numLiterals + 1 = newMethod numLiterals.
        ^self
                installableMethodFor: newMethod
                selector: clone selector
                className: #Character
                isMeta: false!

----- Method: SpurBootstrap>>reportSizes (in category 'bootstrap image') -----
reportSizes
        | change oldAvgBytes newAvgBytes |
        change := newHeapSize - oldHeapSize / oldHeapSize.
        oldAvgBytes := oldHeapSize asFloat / oldHeapNumObjs.
        Transcript
                nextPutAll: 'done.'; cr;
                nextPutAll: 'old heap size: '; nextPutAll: oldHeapSize asStringWithCommas; tab;
                nextPutAll: ' (avg obj bytes '; print: oldAvgBytes maxDecimalPlaces: 2; nextPutAll: ' words '; print: oldAvgBytes / self wordSize maxDecimalPlaces: 2; nextPut: $); cr;
                nextPutAll: 'initial new heap size: '; nextPutAll: newHeapSize asStringWithCommas; cr;
                nextPutAll: 'change: '; print: change * 100.0 maxDecimalPlaces: 2; nextPut: $%; cr;
                flush.
        newHeapSize := newHeap endOfMemory
                                        - newHeap scavenger eden limit
                                        - newHeap totalFreeListBytes.
        change := newHeapSize - oldHeapSize / oldHeapSize.
        newAvgBytes := newHeapSize asFloat / newHeapNumObjs.
        Transcript
                nextPutAll: 'final new heap size: '; nextPutAll: newHeapSize asStringWithCommas; tab;
                nextPutAll: ' (avg obj bytes '; print: newAvgBytes maxDecimalPlaces: 2; nextPutAll: ' words '; print: newAvgBytes / self wordSize maxDecimalPlaces: 2; nextPut: $); cr;
                nextPutAll: 'change: '; print: change * 100.0 maxDecimalPlaces: 2; nextPut: $%; cr;
                flush!

----- Method: SpurBootstrap>>saveTransformedImage (in category 'development support') -----
saveTransformedImage
        ImageHeaderFlags := oldInterpreter getImageHeaderFlags.
        ImageScreenSize := oldInterpreter savedWindowSize.
        ImageName := oldInterpreter imageName.
        newHeap coInterpreter: nil.
        (newHeap class allInstVarNames select: [:ivn| ivn beginsWith: 'stat']) do:
                [:ivn| newHeap instVarNamed: ivn put: 0].
        TransformedImage := newHeap veryDeepCopy!

----- Method: SpurBootstrap>>scavengeImage (in category 'bootstrap image') -----
scavengeImage
        "Scavenge the image to get it into a simpler state."
        newHeap coInterpreter voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
        newHeap flushNewSpace!

----- Method: SpurBootstrap>>selectorForPrototypeMethod: (in category 'method prototypes') -----
selectorForPrototypeMethod: protoMethod
        | protoSelector |
        protoSelector := protoMethod selector.
        protoSelector := protoSelector last: protoSelector size
                                                - (protoSelector indexOfSubCollection: 'PROTOTYPE')
                                                - 'PROTOTYPE' size
                                                + 1.
        (protoSelector beginsWith: 'Dollar') ifTrue:
                [protoSelector := (Dictionary newFromPairs: #('DollarEquals:' #=))
                                                        at: protoSelector].
        ^protoSelector asSymbol!

----- Method: SpurBootstrap>>silenceImage (in category 'bootstrap image') -----
silenceImage
        "Turn off change notifications via SystemChangeNotifier"
        (self allInstancesOf: (self findClassNamed: (self findSymbol: #SystemChangeNotifier))) do:
                [:obj | oldHeap storePointer: 1 ofObject: obj withValue: (oldHeap integerObjectOf: 1)]!

----- Method: SpurBootstrap>>stringFor: (in category 'bootstrap methods') -----
stringFor: aString
        | string |
        string := oldHeap instantiateClass: (oldHeap splObj: ClassByteString) indexableSize: aString size.
        1 to: aString size do:
                [:i| oldHeap storeByte: i - 1 ofObject: string withValue: (aString at: i) asInteger].
        ^string
!

----- Method: SpurBootstrap>>symbolClass (in category 'bootstrap methods') -----
symbolClass
        ^oldHeap fetchClassOfNonImm: (oldHeap splObj: SelectorDoesNotUnderstand)!

----- Method: SpurBootstrap>>transform (in category 'bootstrap image') -----
transform
      self silenceImage.
        self findRequiredGlobals.
        self installModifiedMethods.
        self recreateSpecialObjectsArray.
        self initializeClasses.
        self bootstrapImage.
        self validate.
        self rehashImage.
        self followForwardingPointers.
        self scavengeImage.
        self freeForwarders.
        self compactImage.
        self reportSizes!

----- Method: SpurBootstrap>>validate (in category 'bootstrap image') -----
validate
        | p n duplicates maxClassIndex savedEndOfMemory |
        self assert: (reverseMap at: newHeap specialObjectsOop) = oldHeap specialObjectsOop.
        self assert: (map at: oldHeap specialObjectsOop) = newHeap specialObjectsOop.
        self assert: (reverseMap at: newHeap classTableRootObj ifAbsent: []) isNil.

        duplicates := { 3. newHeap arrayClassIndexPun. newHeap weakArrayClassIndexPun }.
        maxClassIndex := classToIndex inject: 0 into: [:a :b| a max: b].
        self assert: ((newHeap arrayClassIndexPun to: maxClassIndex) select:
                                        [:idx| | classObj |
                                        (classObj := newHeap classOrNilAtIndex: idx) ~= newHeap nilObject
                                        and: [(newHeap classIndexOf: classObj) = (newHeap rawHashBitsOf: classObj)]]) isEmpty.
        0 to: maxClassIndex do:
                [:index| | classObj |
                (index <= newHeap tagMask
                 and: [index > newHeap isForwardedObjectClassIndexPun]) ifTrue:
                        [(classObj := newHeap classOrNilAtIndex: index) = newHeap nilObject
                                ifTrue:
                                        [self assert: (classToIndex keyAtValue: index ifAbsent: []) isNil]
                                ifFalse:
                                        [self assert: (newHeap classIndexOf: classObj) ~= (newHeap rawHashBitsOf: classObj).
                                        (duplicates includes: index) ifFalse:
                                                [self assert: (newHeap rawHashBitsOf: classObj) = index]]]].
        classToIndex keysAndValuesDo:
                [:oldClass :idx|
                self assert: (newHeap rawHashBitsOf: (map at: oldClass)) = idx.
                self assert: oldClass = (reverseMap at: (newHeap classAtIndex: idx))].
        n := 0.
        savedEndOfMemory := newHeap endOfMemory.
        newHeap setEndOfMemory: newHeap freeOldSpaceStart.
        newHeap allObjectsDo:
                [:o|
                (o <= newHeap trueObject
                 or: [o > lastClassTablePage]) ifTrue:
                        [self assert: (reverseMap includesKey: o).
                         self assert: (newHeap fetchClassOfNonImm: o) = (map at: (oldHeap fetchClassOfNonImm: (reverseMap at: o)))].
                n := n + 1.
                p := o].
        newHeap setEndOfMemory: savedEndOfMemory.
        self touch: p.
        self assert: (n between: map size and: map size + ((imageTypes includes: 'squeak')
                                                                                                                ifTrue: [6]
                                                                                                                ifFalse: [10])). "+ 6 or 10 is room for freelists & classTable"

        "check some class properties to ensure the format changes are correct"
        self assert: (newHeap fixedFieldsOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = 0.
        self assert: (newHeap instSpecOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = newHeap arrayFormat!

----- Method: SpurBootstrap>>wordSize (in category 'word size') -----
wordSize
        ^self subclassResponsibility!

----- Method: SpurBootstrap>>wordSizeMask (in category 'word size') -----
wordSizeMask
        ^self subclassResponsibility!

----- Method: SpurBootstrap>>writeSnapshot:ofTransformedImage:headerFlags:screenSize: (in category 'testing') -----
writeSnapshot: imageFileName ofTransformedImage: spurHeap headerFlags: headerFlags screenSize: screenSizeInteger
        "The bootstrapped image typically contains a few big free chunks and one huge free chunk.
         Test snapshot writing and loading by turning the largest non-huge chunks into segment bridges
         and saving."
        | penultimate ultimate sim |
        sim := StackInterpreterSimulator onObjectMemory: spurHeap.
        sim bootstrapping: true.
        spurHeap
                coInterpreter: sim;
                setEndOfMemory: spurHeap endOfMemory + spurHeap bridgeSize. "hack; initializeInterpreter: cuts it back by bridgeSize"
        sim initializeInterpreter: 0;
                setImageHeaderFlagsFrom: headerFlags;
                setSavedWindowSize: screenSizeInteger;
                setDisplayForm: nil.
        spurHeap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
        "Check that we've left behind the old, pre-pigCompact segmented save"
        self assert: (spurHeap isFreeObject: penultimate) not.
        spurHeap checkFreeSpace.
        spurHeap runLeakCheckerForFullGC.
        sim bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: true.
        sim imageName: imageFileName.
        sim writeImageFileIO.
        Transcript cr; show: 'Done!!'!

SpurBootstrap subclass: #SpurBootstrap32
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Bootstrapping'!

----- Method: SpurBootstrap32>>fillInBitsObject:from: (in category 'bootstrap') -----
fillInBitsObject: newObj from: oldObj
        0 to: (oldHeap numSlotsOf: oldObj) - 1 do:
                [:i|
                newHeap
                        storeLong32: i
                        ofObject: newObj
                        withValue: (oldHeap fetchLong32: i ofObject: oldObj)]!

----- Method: SpurBootstrap32>>wordSize (in category 'word size') -----
wordSize
        ^4!

----- Method: SpurBootstrap32>>wordSizeMask (in category 'word size') -----
wordSizeMask
        ^3!

SimulatorHarness subclass: #SpurOldToNewMethodFormatMunger
        instanceVariableNames: 'interpreter heap prototypes replacements symbolOops'
        classVariableNames: ''
        poolDictionaries: 'VMObjectIndices'
        category: 'CogAttic-Bootstrapping'!

!SpurOldToNewMethodFormatMunger commentStamp: 'eem 11/17/2014 10:36' prior: 0!
A SpurOldToNewMethodFormatMunger is a one-off for mirating a Spur image prior to the two formats to single format CompiledMethod header putsch.
!

----- Method: SpurOldToNewMethodFormatMunger>>cloneArrayLiteral: (in category 'munging') -----
cloneArrayLiteral: anArray
        "Currently serves only to clone the #(0 0) literal in SpaceTallyPROTOTYPEspaceForInstancesOf:"
        | array |
        array := heap instantiateClass: (heap splObj: ClassArray) indexableSize: anArray size.
        1 to: anArray size do:
                [:i| | lit |
                lit := anArray at: i.
                lit class caseOf: {
                        [SmallInteger] -> [heap
                                                                        storePointerUnchecked: i - 1
                                                                        ofObject: array
                                                                        withValue: (heap integerObjectOf: lit)].
                        [ByteSymbol] -> [heap
                                                                        storePointer: i - 1
                                                                        ofObject: array
                                                                        withValue: (symbolOops at: lit)].
                        [UndefinedObject] -> [heap
                                                                        storePointerUnchecked: i - 1
                                                                        ofObject: array
                                                                        withValue: heap nilObject] }].
        ^array
!

----- Method: SpurOldToNewMethodFormatMunger>>convertOldMethodHeader: (in category 'munging') -----
convertOldMethodHeader: methodHeader
        ^heap integerObjectOf:
                   ((interpreter argumentCountOfMethodHeader: methodHeader) << 24)
                + ((interpreter temporaryCountOfMethodHeader: methodHeader) << 18)
                + ((interpreter methodHeaderIndicatesLargeFrame: methodHeader) ifTrue: [1 << 17] ifFalse: [0])
                + ((heap primitiveIndexOfMethodHeader: methodHeader) > 0 ifTrue: [1 << 16] ifFalse: [0])
                + (heap literalCountOfMethodHeader: methodHeader)!

----- Method: SpurOldToNewMethodFormatMunger>>incrementPCField:ofObject:by: (in category 'munging') -----
incrementPCField: fieldIndex ofObject: newObj by: n
        | value |
        value := heap fetchPointer: fieldIndex ofObject: newObj.
        (heap isIntegerObject: value)
                ifTrue:
                        [heap
                                storePointerUnchecked: fieldIndex
                                ofObject: newObj
                                withValue: (heap integerObjectOf: n + (heap integerValueOf: value))]
                ifFalse:
                        [self assert: value = heap nilObject]!

----- Method: SpurOldToNewMethodFormatMunger>>indexOfSelector:in: (in category 'munging') -----
indexOfSelector: selectorOop in: methodDict
        SelectorStart to: (heap numSlotsOf: methodDict) - 1 do:
                [:i|
                (heap fetchPointer: i ofObject: methodDict) = selectorOop ifTrue:
                        [^i]].
        self error: 'could not find selector in method dict'!

----- Method: SpurOldToNewMethodFormatMunger>>installableMethodFor:selector:siblingMethod: (in category 'munging') -----
installableMethodFor: methodWithSource selector: selectorOop siblingMethod: sibling
        | method classOop clone delta numBytes |
        method := methodWithSource copyWithTempsFromMethodNode: methodWithSource methodNode.
        delta := (method primitive > 0
                          and: [(method at: method initialPC) ~= method methodClass callPrimitiveCode])
                                ifTrue: [3]
                                ifFalse: [0].
        clone := heap
                                allocateSlots: (heap numSlotsForBytes: (numBytes := method size) + delta)
                                format: (heap compiledMethodFormatForNumBytes: numBytes + delta)
                                classIndex: (heap classIndexOf: sibling).
        classOop := interpreter methodClassOf: sibling.
        method methodClass isMeta ifTrue:
                [classOop := heap fetchPointer: interpreter thisClassIndex ofObject: classOop].
        heap storePointer: 0
                ofObject: clone
                withValue: (self methodHeaderForMethod: method).
        1 to: method numLiterals - 2 do:
                [:i|
                heap storePointer: i
                        ofObject: clone
                        withValue: (self literalFor: (method literalAt: i) inClass: classOop)].
        heap
                storePointer: method numLiterals - 1
                        ofObject: clone
                                withValue: selectorOop;
                storePointer: method numLiterals
                        ofObject: clone
                                withValue: (interpreter methodClassAssociationOf: sibling).

        delta > 0 ifTrue:
                [heap
                        storeByte: method initialPC - 1 ofObject: clone withValue: 139;
                        storeByte: method initialPC + 0 ofObject: clone withValue: (method primitive bitAnd: 255);
                        storeByte: method initialPC + 1 ofObject: clone withValue: (method primitive bitShift: -8)].
        method initialPC to: method size do:
                [:i|
                 heap storeByte: i - 1 + delta ofObject: clone withValue: (method at: i)].

        ^clone!

----- Method: SpurOldToNewMethodFormatMunger>>literalFor:inClass: (in category 'munging') -----
literalFor: aLiteral inClass: classOop
        | bindingOrNil |
        aLiteral isSymbol ifTrue:
                [^symbolOops at: aLiteral].
        aLiteral isString ifTrue:
                [^heap stringForCString: aLiteral].
        (aLiteral isInteger and: [aLiteral class == SmallInteger]) ifTrue:
                [^heap integerObjectOf: aLiteral].
        aLiteral isFloat ifTrue:
                [^heap floatObjectOf: aLiteral].
        aLiteral isArray ifTrue:
                [^self cloneArrayLiteral: aLiteral].
        self assert: aLiteral isVariableBinding.
        "interpreter
                ensureDebugAtEachStepBlock;
                instVarNamed: 'printBytecodeAtEachStep' put: true;
                instVarNamed: 'printFrameAtEachStep' put: true."
        bindingOrNil := self interpreter: interpreter
                                                object: classOop
                                                perform: (symbolOops at: #bindingOf:)
                                                withArguments: {symbolOops at: aLiteral key}.
        bindingOrNil ~= heap nilObject ifTrue:
                [^bindingOrNil].
        self error: 'couldn''t find literal ', aLiteral printString!

----- Method: SpurOldToNewMethodFormatMunger>>mapPCs (in category 'munging') -----
mapPCs
        | cbc cmc |
        cmc := 36.
        cbc := 37.
        heap allObjectsDo:
                [:obj| | ci |
                ci := heap classIndexOf: obj.
                (ci <= 37 and: [ci >= 36]) ifTrue:
                        [ci = 37 ifTrue: [self mungeClosure: obj].
                         ci = 36 ifTrue: [self mungeContext: obj]]]!

----- Method: SpurOldToNewMethodFormatMunger>>methodHeaderForMethod: (in category 'munging') -----
methodHeaderForMethod: method
        ^heap integerObjectOf:
                   (method numArgs << 24)
                + (method numTemps << 18)
                + (method frameSize > method class smallFrameSize ifTrue: [1 << 17] ifFalse: [0])
                + (method primitive > 0 ifTrue: [1 << 16] ifFalse: [0])
                + method numLiterals!

----- Method: SpurOldToNewMethodFormatMunger>>munge: (in category 'public access') -----
munge: imageName
        interpreter := StackInterpreterSimulator newWithOptions: #(ObjectMemory Spur32BitMemoryManager).
        interpreter desiredNumStackPages: 4; initStackPages.
        heap := interpreter objectMemory.
        self assert: heap class == Spur32BitMMLESimulator.
        SpurOldFormat32BitMMLESimulator adoptInstance: heap.
        interpreter openOn: imageName extraMemory: 0.
        self mapPCs.
        self preparePrototypes.
        self updateAndForwardMethods.
        self snapshot!

----- Method: SpurOldToNewMethodFormatMunger>>mungeClosure: (in category 'munging') -----
mungeClosure: obj
        | method |
        method := heap
                                        fetchPointer: MethodIndex
                                        ofObject: (heap
                                                                fetchPointer: ClosureOuterContextIndex
                                                                ofObject: obj).
        (heap primitiveIndexOfMethodHeader: (heap methodHeaderOf: method)) > 0 ifTrue:
                [self incrementPCField: ClosureStartPCIndex ofObject: obj by: 3]!

----- Method: SpurOldToNewMethodFormatMunger>>mungeContext: (in category 'munging') -----
mungeContext: obj
        | method |
        method := heap fetchPointer: MethodIndex ofObject: obj.
        (heap primitiveIndexOfMethodHeader: (heap methodHeaderOf: method)) > 0 ifTrue:
                [self incrementPCField: InstructionPointerIndex ofObject: obj by: 3]!

----- Method: SpurOldToNewMethodFormatMunger>>mungePrimitiveMethod: (in category 'munging') -----
mungePrimitiveMethod: obj
        | numBytes copy firstByteIndex primIndex numPointerSlots header |
        numBytes := heap byteSizeOf: obj.
        copy := heap allocateSlotsInOldSpace: (heap numSlotsForBytes: numBytes + 3)
                                format: (heap compiledMethodFormatForNumBytes: numBytes + 3)
                                classIndex: (heap classIndexOf: obj).
        header := heap methodHeaderOf: obj.
        numPointerSlots := (heap literalCountOfMethodHeader: header) + LiteralStart.
        heap
                storePointerUnchecked: 0
                ofObject: copy
                withValue: (self convertOldMethodHeader: header).
        1 to: numPointerSlots - 1 do:
                [:i|
                heap storePointer: i
                        ofObject: copy
                        withValue: (heap fetchPointer: i ofObject: obj)].
        primIndex := heap primitiveIndexOfMethodHeader: header.
        firstByteIndex := numPointerSlots * heap bytesPerOop.
        heap
                storeByte: firstByteIndex + 0 ofObject: copy withValue: 139;
                storeByte: firstByteIndex + 1 ofObject: copy withValue: (primIndex bitAnd: 255);
                storeByte: firstByteIndex + 2 ofObject: copy withValue: (primIndex bitShift: -8).
        firstByteIndex to: numBytes - 1 do:
                [:i|
                heap storeByte: i + 3 ofObject: copy withValue: (heap fetchByte: i ofObject: obj)].
        heap forward: obj to: copy.
        ^copy!

----- Method: SpurOldToNewMethodFormatMunger>>preparePrototypes (in category 'munging') -----
preparePrototypes
        replacements := OrderedCollection new.
        heap classTableObjectsDo:
                [:class| | name isMeta |
                name := heap
                                        fetchPointer: interpreter classNameIndex
                                        ofObject: ((isMeta := (heap numSlotsOf: class) = interpreter metaclassNumSlots)
                                                                ifTrue: [heap fetchPointer: interpreter thisClassIndex ofObject: class]
                                                                ifFalse: [class]).
                name := interpreter stringOf: name.
                self prototypeClassNameMetaSelectorMethodDo:
                        [:protoClassName :protoIsMeta :selector :method|
                         (protoClassName = name
                          and: [protoIsMeta = isMeta]) ifTrue:
                                [replacements addLast: {class. selector. method}]]]!

----- Method: SpurOldToNewMethodFormatMunger>>prototypeClassNameMetaSelectorMethodDo: (in category 'munging') -----
prototypeClassNameMetaSelectorMethodDo: quaternaryBlock
        prototypes ifNil:
                [prototypes := OrderedCollection new.
                SpurBootstrap new prototypeClassNameMetaSelectorMethodDo:
                        [:className :isMeta :selector :method|
                        (#(BytecodeEncoder CompiledMethod EncoderForSqueakV4PlusClosures
                                InstructionClient InstructionStream MethodNode) includes: className) ifTrue:
                                        [prototypes addLast: {className. isMeta. selector. method}]]].
        prototypes do: [:tuple| quaternaryBlock valueWithArguments: tuple]!

----- Method: SpurOldToNewMethodFormatMunger>>replaceMethods (in category 'munging') -----
replaceMethods
        | byteSymbolClassIndex symbols symbolSizes |
        byteSymbolClassIndex := heap classIndexOf: (heap splObj: SelectorDoesNotUnderstand).
        symbols := Set with: #bindingOf:.
        replacements do:
                [:tuple| | method adder |
                symbols add: tuple second.
                method := tuple last.
                adder := [:lit|
                                   (lit isSymbol and: [lit ~~ method selector]) ifTrue: [symbols add: lit].
                                   (lit isVariableBinding and: [lit key isSymbol]) ifTrue: [symbols add: lit key].
                                   lit isArray ifTrue: [lit do: adder]].
                method literals do: adder].
        symbolSizes := symbols collect: [:ea| ea size].
        symbolOops := Dictionary new.
        heap allObjectsDo:
                [:obj| | sz |
                ((heap classIndexOf: obj) = byteSymbolClassIndex
                 and: [symbolSizes includes: (sz := heap numBytesOf: obj)]) ifTrue:
                        [symbols do:
                                [:s|
                                 (sz = s size
                                  and: [(interpreter stringOf: obj) = s]) ifTrue:
                                        [symbolOops at: s put: obj]]]].
        replacements do:
                [:tuple|
                [:classOop :selector :method| | replacement methodDict methodArray index |
                methodDict := heap fetchPointer: MethodDictionaryIndex ofObject: classOop.
                methodArray := heap fetchPointer: MethodArrayIndex ofObject: methodDict.
                index := (0 to: (heap numSlotsOf: methodArray) - 1) detect: [:i| (heap fetchPointer: i ofObject: methodArray) ~= heap nilObject].
                replacement := self installableMethodFor: method
                                                        selector: (symbolOops at: selector)
                                                        siblingMethod: (heap fetchPointer: index ofObject: methodArray).
                index := self indexOfSelector: (symbolOops at: selector) in: methodDict.
                heap
                        storePointer: index - SelectorStart
                        ofObject: methodArray
                        withValue: replacement] valueWithArguments: tuple]!

----- Method: SpurOldToNewMethodFormatMunger>>snapshot (in category 'saving') -----
snapshot
        Spur32BitMMLESimulator adoptInstance: heap.
        interpreter imageName: 'munged-', (FileDirectory default localNameFor: interpreter imageName).
        [heap parent: heap; setCheckForLeaks: 15; garbageCollectForSnapshot]
                on: Halt
                do: [:ex|
                        "suppress halts from the usual suspects (development time halts)"
                        (#(fullGC globalGarbageCollect) includes: ex signalerContext sender selector)
                                ifTrue: [ex resume]
                                ifFalse: [ex pass]].
        interpreter
                setDisplayForm: nil; "gets it to use savedWindowSize"
                writeImageFileIO.
        Transcript cr; show: 'Done!!'!

----- Method: SpurOldToNewMethodFormatMunger>>updateAndForwardMethods (in category 'munging') -----
updateAndForwardMethods
        | new now lastDotTime |
        new := Set new: 1000.
        lastDotTime := Time now asSeconds.
        heap allObjectsDo:
                [:obj|
                ((heap isCompiledMethod: obj)
                 and: [(new includes: obj) not]) ifTrue:
                        [| header |
                         (heap primitiveIndexOfMethodHeader: (header := heap methodHeaderOf: obj)) > 0
                                ifTrue:
                                        [new add: (self mungePrimitiveMethod: obj).
                                         (now := Time now asSeconds) > lastDotTime ifTrue:
                                                [Transcript nextPut: $.; flush.
                                                 lastDotTime := now]]
                                ifFalse:
                                        [heap
                                                storePointerUnchecked: 0
                                                ofObject: obj
                                                withValue: (self convertOldMethodHeader: header)]]].
        Spur32BitMMLESimulator adoptInstance: interpreter objectMemory.
        self withExecutableInterpreter: interpreter
                do: [self replaceMethods]!

CogScripts subclass: #CogScriptsAttic
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CogAttic-Scripts'!

----- Method: CogScriptsAttic class>>createSVMTree (in category 'separate vm scripts') -----
createSVMTree
        "Create the parallel StackInterpreterS, CoInterpreterS tree in which
         objectMemory is an inst var rather than ObjectMemory et al being a superclass"
        "CogScripts createSVMTree"

        | changes map |
        changes := Cursor execute showWhile: [self changedMethodsForObjectMemorySends].

        map := Cursor execute showWhile: [self createStackInterpreterSHierarchy].

        (ChangeSet superclassOrder: (StackInterpreter withAllSubclasses select: [:c| map includesKey: c]) asArray) do:
                [:sourceClass|
                sourceClass selectors do:
                        [:sel| | destClass source stamp |
                        destClass := map
                                                        at: (((sel beginsWith: 'primitive')
                                                                and: [sel last ~~ $:
                                                                and: [sel ~~ #primitiveFail]])
                                                                        ifTrue: [{sourceClass. #primitives}]
                                                                        ifFalse: [sourceClass])
                                                        ifAbsent: [map at: sourceClass].
                        (changes detect: [:c| c changeClass == sourceClass and: [c selector = sel]] ifNone: [])
                                ifNotNil:
                                        [:change|
                                        source := change source.
                                        stamp := Utilities changeStamp copyReplaceAll: Utilities authorInitials with: Utilities authorInitials, ' (objmem refactor)']
                                ifNil:
                                        [source := sourceClass sourceCodeAt: sel.
                                        stamp := (sourceClass >> sel) timeStamp].
                        [destClass
                                        compile: source
                                        classified: (sourceClass whichCategoryIncludesSelector: sel)
                                        withStamp: stamp
                                        notifying: nil]
                                on: SyntaxErrorNotification
                                do: [:ex| | newBrowser |
                                        newBrowser := Browser new setClass: destClass selector: nil.
                                        newBrowser selectMessageCategoryNamed: (sourceClass whichCategoryIncludesSelector: sel).
                                        Browser
                                                openBrowserView: (newBrowser openMessageCatEditString: source)
                                                label: 'category "', (sourceClass whichCategoryIncludesSelector: sel), '" in ', destClass name]]].

        self readWriteVars, self readOnlyVars do:
                [:sym|
                (NewObjectMemory whichClassIncludesSelector: sym) ifNil:
                        [(NewObjectMemory whichClassDefinesInstVar: sym asString)
                                compile: sym, (String with: Character cr with: Character tab with: $^), sym
                                classified: #accessing]].
        self readWriteVars do:
                [:sym| | setter | setter := (sym, ':') asSymbol.
                (NewObjectMemory whichClassIncludesSelector: setter) ifNil:
                        [(NewObjectMemory whichClassDefinesInstVar: sym asString)
                                compile: setter, ' aValue', (String with: Character cr with: Character tab with: $^), sym, ' := aValue'
                                classified: #accessing]].!

----- Method: CogScriptsAttic class>>createStackInterpreterSHierarchy (in category 'separate vm scripts') -----
createStackInterpreterSHierarchy
        "Create the parallel StackInterpreterS, CoInterpreterS tree (without methods).
         Answer a Dictionary maping source class to dest class with {source. #primitives} -> dest
         for the added primitives classes."

        | map |
        (Smalltalk classNamed: #StackInterpreterS) ifNotNil:
                [:sis|
                (Object confirm: 'StackInterpreterS exists, nuke?') ifTrue:
                        [(ChangeSet superclassOrder: sis withAllSubclasses asArray) reverseDo:
                                [:sissc| sissc removeFromSystemUnlogged]]].

        map := Dictionary new.
        (ChangeSet superclassOrder: (StackInterpreter withAllSubclasses
                                                                        remove: SchizophrenicClosureFormatStackInterpreter;
                                                                        yourself) asArray) do:
                [:sisc| | def |
                def := sisc definition.
                def := sisc == StackInterpreter
                                ifTrue: [((def copyReplaceAll: sisc superclass name, ' ' with: ObjectMemory superclass name, ' ')
                                                        copyReplaceAll: 'instanceVariableNames: ''' with: 'instanceVariableNames: ''objectMemory ')
                                                        copyReplaceAll: 'poolDictionaries: ''' with: 'poolDictionaries: ''', (ObjectMemory poolDictionaryNames fold: [:a :b| a, ' ', b]), ' ']
                                ifFalse: [def copyReplaceAll: sisc superclass name, ' ' with: sisc superclass name, 'S '].
                def := def copyReplaceAll: sisc name printString with: sisc name printString, 'S'.
                map at: sisc put: (Compiler evaluate: def)].

        map at: {StackInterpreter. #primitives}
                put: (Compiler
                                evaluate: 'StackInterpreterS subclass: #StackInterpreterSPrimitives
                                                        instanceVariableNames: ''''
                                                        classVariableNames: ''''
                                                        poolDictionaries: ''''
                                                        category: ''VMMaker-Interpreter''');
                at: {CoInterpreter. #primitives}
                put: (Compiler
                                evaluate: 'CoInterpreterS subclass: #CoInterpreterSPrimitives
                                                instanceVariableNames: ''''
                                                classVariableNames: ''''
                                                poolDictionaries: ''''
                                                category: ''VMMaker-Interpreter''');
                at: {StackInterpreter. #objmem}
                put: (Compiler
                                evaluate: 'NewObjectMemory subclass: #NewObjectMemoryS
                                                instanceVariableNames: ''coInterpreter''
                                                        classVariableNames: ''''
                                                        poolDictionaries: ''''
                                                        category: ''VMMaker-Interpreter''');
                at: {CoInterpreter. #objmem}
                put: (Compiler
                                evaluate: 'NewObjectMemoryS subclass: #NewCoObjectMemoryS
                                                instanceVariableNames: ''''
                                                classVariableNames: ''''
                                                poolDictionaries: ''''
                                                category: ''VMMaker-Interpreter''').

        "reparent subclasses underneath StackInterpreterSPrimitives & CoInterpreterSPrimitives"
        #(StackInterpreterS CoInterpreterS) do:
                [:cn|
                ((Smalltalk classNamed: cn) subclasses reject: [:c| c name endsWith: 'Primitives']) do:
                        [:sisc| | def |
                        def := sisc definition.
                        def := def copyReplaceAll: cn, ' ' with: cn, 'Primitives '.
                        Compiler evaluate: def]].
        ^map!