[Vm-dev] VM Maker: Cog-EstebanLorenzano.274.mcz
Esteban Lorenzano
estebanlm at gmail.com
Wed Jul 1 12:27:24 UTC 2015
sorry, I made a stupid bad commit… please remove?
thanks!
Esteban
> On 01 Jul 2015, at 12:25, commits at source.squeak.org wrote:
>
>
> Esteban Lorenzano uploaded a new version of Cog to project VM Maker:
> http://source.squeak.org/VMMaker/Cog-EstebanLorenzano.274.mcz
>
> ==================== Summary ====================
>
> Name: Cog-EstebanLorenzano.274
> Author: EstebanLorenzano
> Time: 1 July 2015, 2:25:04.350718 pm
> UUID: c99c1364-253e-4ede-8620-e8df4e8cb3f5
> Ancestors: Cog-EstebanLorenzano.273
>
> special objects array needs to store BoxedFloat64, not Float
>
> =============== Diff against Cog-eem.270 ===============
>
> Item was changed:
> + SystemOrganization addCategory: #Cog!
> + SystemOrganization addCategory: 'Cog-Bootstrapping'!
> + SystemOrganization addCategory: 'Cog-Morphing Bytecode Set'!
> + SystemOrganization addCategory: 'Cog-ProcessorPlugins'!
> + SystemOrganization addCategory: 'Cog-Processors'!
> + SystemOrganization addCategory: 'Cog-Processors-Tests'!
> + SystemOrganization addCategory: 'Cog-Scripting'!
> + SystemOrganization addCategory: 'Cog-Scripts'!
> + SystemOrganization addCategory: 'Cog-Tests'!
> - SystemOrganization addCategory: #'Cog-Bootstrapping'!
> - SystemOrganization addCategory: #'Cog-Morphing Bytecode Set'!
> - SystemOrganization addCategory: #'Cog-ProcessorPlugins'!
> - SystemOrganization addCategory: #'Cog-Processors'!
> - SystemOrganization addCategory: #'Cog-Processors-Tests'!
> - SystemOrganization addCategory: #'Cog-Scripting'!
> - SystemOrganization addCategory: #'Cog-Scripts'!
> - SystemOrganization addCategory: #'Cog-Tests'!
>
> Item was changed:
> ----- Method: Behavior>>BehaviorPROTOTYPEinstSize (in category '*Cog-method prototypes') -----
> BehaviorPROTOTYPEinstSize
> "Answer the number of named instance variables
> (as opposed to indexed variables) of the receiver.
> Above Cog Spur the class format is
> <5 bits inst spec><16 bits inst size>"
> ^format bitAnd: 16rFFFF!
>
> Item was changed:
> ----- Method: Behavior>>BehaviorPROTOTYPEinstSpec (in category '*Cog-method prototypes') -----
> BehaviorPROTOTYPEinstSpec
> "Answer the instance specification part of the format that defines what kind of object
> an instance of the receiver is. The formats are
> 0 = 0 sized objects (UndefinedObject True False et al)
> 1 = non-indexable objects with inst vars (Point et al)
> 2 = indexable objects with no inst vars (Array et al)
> 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
> 4 = weak indexable objects with inst vars (WeakArray et al)
> 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
> 6 = unused
> 7 = immediates (SmallInteger, Character)
> 8 = unused
> 9 = 64-bit indexable
> 10-11 = 32-bit indexable (Bitmap)
> 12-15 = 16-bit indexable
> 16-23 = 8-bit indexable
> 24-31 = compiled methods (CompiledMethod)"
> ^(format bitShift: -16) bitAnd: 16r1F!
>
> Item was changed:
> ----- Method: BlockClosure>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category '*Cog-method prototypes') -----
> BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
> "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
> | newContext sz |
> + newContext := (Context newForMethod: outerContext method)
> - newContext := (MethodContext newForMethod: outerContext method)
> setSender: aContext
> receiver: outerContext receiver
> method: outerContext method
> closure: self
> startpc: startpc.
> ((newContext objectClass: anArray) ~~ Array
> or: [numArgs ~= anArray size]) ifTrue:
> + [^Context primitiveFailTokenFor: nil].
> - [^ContextPart primitiveFailTokenFor: nil].
> sz := self basicSize.
> newContext stackp: sz + numArgs.
> 1 to: numArgs do:
> [:i| newContext at: i put: (anArray at: i)].
> 1 to: sz do:
> [:i| newContext at: i + numArgs put: (self at: i)].
> ^newContext!
>
> Item was added:
> + ----- Method: ClassDescription>>ClassDescriptionPROTOTYPEmethodClassAssociation: (in category '*Cog-method prototypes squeak') -----
> + ClassDescriptionPROTOTYPEmethodClassAssociation: aBinding
> + "sets the association to the class that I am installed in"
> + ^self literalAt: self numLiterals put: aBinding!
>
> Item was changed:
> ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category '*Cog-method prototypes') -----
> CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
> + ^ 0
> + "anEncoder class == PrimaryBytecodeSetEncoderClass ifTrue: [ ^0 ].
> + anEncoder class == SecondaryBytecodeSetEncoderClass ifTrue: [ ^SmallInteger minVal ].
> + self error: 'The encoder is not one of the two installed byte code sets'"!
> - anEncoder class == PrimaryBytecodeSetEncoderClass ifTrue:
> - [^0].
> - anEncoder class == SecondaryBytecodeSetEncoderClass ifTrue:
> - [^SmallInteger minVal].
> - self error: 'The encoder is not one of the two installed bytecode sets'!
>
> Item was changed:
> ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEinitialize (in category '*Cog-method prototypes') -----
> CompiledMethodclassPROTOTYPEinitialize "CompiledMethod initialize"
> "Initialize class variables specifying the size of the temporary frame
> needed to run instances of me."
>
> SmallFrame := 16. "Context range for temps+stack"
> LargeFrame := 56.
> PrimaryBytecodeSetEncoderClass ifNil:
> [PrimaryBytecodeSetEncoderClass := EncoderForV3PlusClosures].
> SecondaryBytecodeSetEncoderClass ifNil:
> [SecondaryBytecodeSetEncoderClass := EncoderForV3PlusClosures]!
>
> Item was changed:
> ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category '*Cog-method prototypes') -----
> CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
> PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue:
> [^self].
> (aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse:
> [self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder'].
> (self allSubInstances
> detect: [:m| m header >= 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]]
> ifNone: []) ifNotNil:
> [Warning signal: 'There are existing CompiledMethods with a different encoderClass.'].
> PrimaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass!
>
> Item was changed:
> ----- Method: CompiledMethod>>CompiledMethodPROTOTYPEencoderClass (in category '*Cog-method prototypes') -----
> CompiledMethodPROTOTYPEencoderClass
> "Answer the encoder class that encoded the bytecodes in this method.
> The sign flag bit is used by the VM to select a bytecode set. This formulation
> may seem odd but this has to be fast, so no property probe unless needed."
>
> ^self header >= 0
> ifTrue:
> [PrimaryBytecodeSetEncoderClass]
> ifFalse:
> [PrimaryBytecodeSetEncoderClass == SecondaryBytecodeSetEncoderClass
> ifTrue: "Support for testing prior to installing another set"
> [(self propertyValueAt: #encoderClass) ifNil: [SecondaryBytecodeSetEncoderClass]]
> ifFalse:
> [SecondaryBytecodeSetEncoderClass]]!
>
> Item was removed:
> - ----- Method: ContextPart>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category '*Cog-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:
> - [ToolSet
> - debugContext: 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: 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:
> - [^ContextPart 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]!
>
> Item was removed:
> - ----- Method: ContextPart>>ContextPartPROTOTYPEisPrimFailToken: (in category '*Cog-method prototypes') -----
> - ContextPartPROTOTYPEisPrimFailToken: anObject
> - ^(self objectClass: anObject) == Array
> - and: [anObject size = 2
> - and: [anObject first == PrimitiveFailToken]]!
>
> Item was changed:
> ----- Method: Decompiler>>DecompilerPROTOTYPEdecompile:in:method:using: (in category '*Cog-method prototypes squeak 4.3') -----
> DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor
>
> | block node |
> constructor := aConstructor.
> method := aMethod.
> self initSymbols: aClass. "create symbol tables"
> method isQuick
> ifTrue: [block := self quickMethod]
> ifFalse:
> [stack := OrderedCollection new: method frameSize.
> lastJumpIfPcStack := OrderedCollection new.
> caseExits := OrderedCollection new.
> statements := OrderedCollection new: 20.
> numLocalTemps := 0.
> super method: method pc: method initialPC.
> "skip primitive error code store if necessary"
> (method primitive ~= 0 and: [self skipCallPrimitive; willStore]) ifTrue:
> [pc := pc + (method encoderClass bytecodeSize: self firstByte).
> tempVars := tempVars asOrderedCollection].
> block := self blockTo: method endPC + 1.
> stack isEmpty ifFalse: [self error: 'stack not empty']].
> node := constructor
> codeMethod: aSelector
> block: block
> tempVars: tempVars
> primitive: method primitive
> class: aClass.
> method primitive > 0 ifTrue:
> [node removeAndRenameLastTempIfErrorCode].
> ^node preen!
>
> Item was changed:
> ----- Method: InstructionStream>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category '*Cog-method prototypes') -----
> InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client
> | type offset2 byte2 byte3 byte4 |
> offset <= 6 ifTrue:
> ["Extended op codes 128-134"
> byte2 := method at: pc. pc := pc + 1.
> offset <= 2 ifTrue:
> ["128-130: extended pushes and pops"
> type := byte2 // 64.
> offset2 := byte2 \\ 64.
> offset = 0 ifTrue:
> [type = 0 ifTrue: [^client pushReceiverVariable: offset2].
> type = 1 ifTrue: [^client pushTemporaryVariable: offset2].
> type = 2 ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)].
> type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]].
> offset = 1 ifTrue:
> [type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2].
> type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2].
> type = 2 ifTrue: [self error: 'illegalStore'].
> type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
> offset = 2 ifTrue:
> [type = 0 ifTrue: [^client popIntoReceiverVariable: offset2].
> type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2].
> type = 2 ifTrue: [self error: 'illegalStore'].
> type = 3 ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
> "131-134: extended sends"
> offset = 3 ifTrue: "Single extended send"
> [^client send: (method literalAt: byte2 \\ 32 + 1)
> super: false numArgs: byte2 // 32].
> offset = 4 ifTrue: "Double extended do-anything"
> [byte3 := method at: pc. pc := pc + 1.
> type := byte2 // 32.
> type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1)
> super: false numArgs: byte2 \\ 32].
> type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1)
> super: true numArgs: byte2 \\ 32].
> type = 2 ifTrue: [^client pushReceiverVariable: byte3].
> type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)].
> type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)].
> type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3].
> type = 6 ifTrue: [^client popIntoReceiverVariable: byte3].
> type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
> offset = 5 ifTrue: "Single extended send to super"
> [^client send: (method literalAt: byte2 \\ 32 + 1)
> super: true
> numArgs: byte2 // 32].
> offset = 6 ifTrue: "Second extended send"
> [^client send: (method literalAt: byte2 \\ 64 + 1)
> super: false
> numArgs: byte2 // 64]].
> offset = 7 ifTrue: [^client doPop].
> offset = 8 ifTrue: [^client doDup].
> offset = 9 ifTrue: [^client pushActiveContext].
> byte2 := method at: pc. pc := pc + 1.
> offset = 10 ifTrue:
> [^byte2 < 128
> ifTrue: [client pushNewArrayOfSize: byte2]
> ifFalse: [client pushConsArrayWithElements: byte2 - 128]].
> byte3 := method at: pc. pc := pc + 1.
> offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)].
> offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3].
> offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
> offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
> "offset = 15"
> byte4 := method at: pc. pc := pc + 1.
> ^client
> pushClosureCopyNumCopiedValues: (byte2 bitShift: -4)
> numArgs: (byte2 bitAnd: 16rF)
> blockSize: (byte3 * 256) + byte4!
>
> Item was changed:
> ----- Method: InstructionStream>>InstructionStreamPROTOTYPEnextPc: (in category '*Cog-method prototypes') -----
> InstructionStreamPROTOTYPEnextPc: currentByte
> "Answer the pc of the next bytecode following the current one, given the current bytecode.."
>
> ^pc + (self method encoderClass bytecodeSize: currentByte)!
>
> Item was changed:
> ----- Method: MCClassDefinition>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category '*Cog-method prototypes squeak 4.3') -----
> MCClassDefinitionPROTOTYPEkindOfSubclass
> type = #normal ifTrue: [^' subclass: '].
> type = #variable ifTrue: [^' variableSubclass: '].
> type = #bytes ifTrue: [^' variableByteSubclass: '].
> type = #compiledMethod ifTrue: [^' variableByteSubclass: ' ].
> type = #words ifTrue: [^' variableWordSubclass: '].
> type = #weak ifTrue: [^' weakSubclass: ' ].
> type = #ephemeron ifTrue: [^' ephemeronSubclass: ' ].
> type = #immediate ifTrue: [^' immediateSubclass: ' ].
> self error: 'Unrecognized class type'!
>
> Item was changed:
> ----- Method: MCMethodDefinition>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category '*Cog-method prototypes squeak 4.3') -----
> MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString
> classIsMeta: metaBoolean
> selector: selectorString
> category: catString
> timeStamp: timeString
> source: sourceString
> className := classString asSymbol.
> selector := selectorString asSymbol.
> category := catString ifNil: [Categorizer default] ifNotNil: [catString asSymbol].
> timeStamp := timeString.
> classIsMeta := metaBoolean.
> source := sourceString withSqueakLineEndings!
>
> Item was removed:
> - ----- Method: MethodContext>>MethodContextPROTOTYPEfailPrimitiveWith: (in category '*Cog-method prototypes') -----
> - MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
> - "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive:
> - bytecode and store the primitive fail code if there is one and the method consumes it."
> - self skipCallPrimitive.
> - ((self isPrimFailToken: maybePrimFailToken)
> - and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
> - [self at: stackp put: maybePrimFailToken last]!
>
> Item was removed:
> - ----- Method: MethodContext>>xray (in category '*Cog-Tests-xrays') -----
> - xray
> - "Lift the veil from a context and answer an integer describing its interior state.
> - Used for e.g. VM tests so they can verify they're testing what they think they're testing.
> - 0 implies a vanilla heap context.
> - Bit 0 = is or was married to a frame
> - Bit 1 = is still married to a frame
> - Bit 2 = frame is executing machine code
> - Bit 3 = has machine code pc (as opposed to nil or a bytecode pc)
> - Bit 4 = method is currently compiled to machine code"
> - <primitive: 213>
> - ^0 "Can only fail if unimplemented; therefore simply answer 0"!
>
> Item was removed:
> - ----- Method: MethodContext>>xrayIsDivorced (in category '*Cog-Tests-xrays') -----
> - xrayIsDivorced
> - ^(self xray bitAnd: 3) = 1!
>
> Item was removed:
> - ----- Method: MethodContext>>xrayIsExecutingMachineCode (in category '*Cog-Tests-xrays') -----
> - xrayIsExecutingMachineCode
> - ^self xray anyMask: 4!
>
> Item was removed:
> - ----- Method: MethodContext>>xrayIsMarried (in category '*Cog-Tests-xrays') -----
> - xrayIsMarried
> - ^self xray anyMask: 2!
>
> Item was removed:
> - ----- Method: MethodContext>>xrayLastExecutedMachineCode (in category '*Cog-Tests-xrays') -----
> - xrayLastExecutedMachineCode
> - ^self xray anyMask: 8!
>
> Item was removed:
> - ----- Method: MethodContext>>xrayMethodIsCompiledToMachineCode (in category '*Cog-Tests-xrays') -----
> - xrayMethodIsCompiledToMachineCode
> - ^self xray anyMask: 16!
>
> Item was added:
> + ----- Method: MethodNode>>MethodNodePROTOTYPEgenerate:using:ifQuick: (in category '*Cog-method prototypes') -----
> + MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass ifQuick: methodBlock
> + | v |
> + (primitive = 0 and: [arguments size = 0 and: [block isQuick]]) ifFalse:
> + [^self].
> + v := block code.
> + v < 0 ifTrue:
> + [^self].
> + v = LdSelf ifTrue:
> + [^methodBlock value: (aCompiledMethodClass toReturnSelfTrailerBytes: trailer)].
> + (v between: LdTrue and: LdMinus1 + 3) ifTrue:
> + [^methodBlock value: (aCompiledMethodClass toReturnConstant: v - LdSelf trailerBytes: trailer)].
> + v < ((CodeBases at: LdInstType) + (CodeLimits at: LdInstType)) ifTrue:
> + [^methodBlock value: (aCompiledMethodClass toReturnField: v trailerBytes: trailer)].
> + v // 256 = 1 ifTrue:
> + [^methodBlock value: (aCompiledMethodClass toReturnField: v \\ 256 trailerBytes: trailer)]!
>
> Item was changed:
> ----- Method: SimulatorHarness>>interpreter:object:perform:withArguments: (in category 'bootstrap methods') -----
> interpreter: sim object: receiver perform: selector withArguments: arguments
> "Interpret an expression in oldHeap using oldInterpreter.
> Answer the result."
> | fp savedpc savedsp savedStackPages result startByteCount |
> self assert: ({receiver. selector}, arguments allSatisfy:
> [:oop| oop isInteger and: [sim objectMemory addressCouldBeOop: oop]]).
> savedpc := sim localIP.
> savedsp := sim localSP.
> savedStackPages := Set with: sim stackPage.
> sim internalPush: receiver.
> arguments do: [:arg| sim internalPush: arg].
> sim
> argumentCount: arguments size;
> messageSelector: selector.
> fp := sim localFP.
> startByteCount := sim byteCount.
> "sim byteCount = 66849 ifTrue: [self halt]."
> sim normalSend.
> sim incrementByteCount. "otherwise, send is not counted"
> ["sim printFrame: sim localFP WithSP: sim localSP"
> "sim setBreakSelector: #elementsForwardIdentityTo:"
> "sim byteCount = 66849 ifTrue: [self halt]."
> "(sim byteCount > 7508930 and: [sim localFP = -16r27894]) ifTrue:
> [self halt]."
> fp = sim localFP] whileFalse:
> [sim singleStep.
> (savedStackPages includes: sim stackPage) ifFalse: "If the stack gets deep something has probably gone wrong..."
> [savedStackPages size > 20 ifTrue: [self halt].
> savedStackPages add: sim stackPage]].
> result := sim internalPopStack.
> self assert: savedsp = sim localSP.
> self assert: sim localIP - 1 = savedpc.
> sim localIP: savedpc.
> ^result!
>
> Item was changed:
> ----- Method: SimulatorHarness>>withExecutableInterpreter:do: (in category 'bootstrap methods') -----
> withExecutableInterpreter: sim do: aBlock
> "With the oldInterpreter ready to execute code, evaluate aBlock,
> then return the interpreter (and the heap) to the ``just snapshotted'' state."
> | savedpc savedfp initialContext finalContext |
> sim
> initStackPages;
> loadInitialContext;
> internalizeIPandSP.
> savedpc := sim localIP.
> savedfp := sim localFP.
> "sim printHeadFrame."
> aBlock value.
> "sim printHeadFrame."
> sim
> internalPush: sim localIP;
> externalizeIPandSP.
> "now undo the execution state"
> self assert: sim localFP = savedfp.
> initialContext := sim frameContext: savedfp.
> finalContext := sim voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
> self assert: initialContext = finalContext.
> self assert: sim localIP = savedpc.
> sim objectMemory
> storePointer: SuspendedContextIndex
> ofObject: sim activeProcess
> withValue: finalContext!
>
> Item was changed:
> ----- 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 ]!
>
> Item was changed:
> ----- Method: SpurBootstrap>>allPrototypeMethodSymbols (in category 'method prototypes') -----
> allPrototypeMethodSymbols
> "self basicNew allPrototypeMethodSymbols"
> | symbols |
> + "self assert: SpurBootstrap isolatedPrototypes isEmpty."
> - 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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'))!
>
> Item was changed:
> ----- 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.
>
> 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: #()]]]]!
>
> Item was changed:
> ----- 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 sizes counts barriers 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;
> setDisplayForm: nil.
> spurHeap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
> (spurHeap isFreeObject: penultimate) ifTrue: "old, pre-pigCompact segmented save"
> [self assert: (spurHeap isSegmentBridge: ultimate).
> sizes := Bag new.
> spurHeap allObjectsInFreeTree: (spurHeap freeLists at: 0) do:
> [:f|
> sizes add: (spurHeap bytesInObject: f)].
> counts := sizes sortedCounts.
> self assert: counts last key = 1. "1 huge chunk"
> counts size > 1
> ifTrue:
> [self assert: ((counts at: counts size - 1) key > 2
> and: [(counts at: counts size - 1) value > 1024]).
> barriers := (1 to: (counts at: counts size - 1) key) collect:
> [:ign| spurHeap allocateOldSpaceChunkOfExactlyBytes: (counts at: counts size - 1) value].
> barriers := barriers, {spurHeap allocateOldSpaceChunkOfExactlyBytes: (spurHeap bytesInObject: penultimate)}]
> ifFalse:
> [barriers := {spurHeap allocateOldSpaceChunkOfExactlyBytes: (spurHeap bytesInObject: penultimate)}].
> barriers last ifNotNil:
> [:end|
> spurHeap setEndOfMemory: end.
> spurHeap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e].
> self assert: (spurHeap addressAfter: ultimate) = end]].
> spurHeap checkFreeSpace.
> spurHeap runLeakCheckerForFullGC.
> barriers ifNotNil: "old, pre-pigCompact segmented save"
> [spurHeap segmentManager initializeFromFreeChunks: (barriers sort collect: [:b| spurHeap objectStartingAt: b])].
> spurHeap checkFreeSpace.
> spurHeap runLeakCheckerForFullGC.
> sim bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf: true.
> sim imageName: imageFileName.
> sim writeImageFileIO.
> Transcript cr; show: 'Done!!'!
>
> Item was added:
> + SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapOldSqueakPrototypes
> + instanceVariableNames: ''
> + classVariableNames: ''
> + poolDictionaries: ''
> + category: 'Cog-Bootstrapping'!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was added:
> + ----- Method: SpurBootstrapPharoPrototypes>>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 class)
> + + (numArgs bitShift: 24)
> + + (numTemps bitShift: 18)
> + "+ (largeBit bitShift: 17)" "largeBit gets filled in later"
> + + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
> + + numLits!
>
> Item was changed:
> ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
> CharacterPROTOTYPEsetValue: newValue
> self error: 'Characters are immutable'!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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]!
>
> Item was added:
> + ----- Method: SpurBootstrapPharoPrototypes>>MethodNodePROTOTYPEgenerate:using:ifQuick: (in category 'method prototypes') -----
> + MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass ifQuick: methodBlock
> + <indirect>!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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: BoxedFloat64.
> - 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!
>
> Item was added:
> + ----- Method: SpurBootstrapPharoPrototypes>>StringPROTOTYPEadaptToNumber:andSend: (in category 'method prototypes') -----
> + StringPROTOTYPEadaptToNumber: receiver andSend: selector
> + "If I am involved in arithmetic with a number, convert me to a number."
> + self flag: #todo. "This is needed for the conversion to spur... please remove me"
> + ^ receiver perform: selector with: self asNumber!
>
> Item was changed:
> ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
> TraitBehaviorPROTOTYPEallInstances
> "Answer all instances of the receiver."
> self error: 'Traits does not have instances.'!
>
> Item was changed:
> ----- 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.'!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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]]!
>
> Item was changed:
> ----- 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: ']]]!
>
> Item was changed:
> ----- 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"!
>
> Item was added:
> + ----- Method: SpurBootstrapPharoPrototypes>>WeakFinalizationListclassPROTOTYPEhasNewFinalization (in category 'method prototypes') -----
> + WeakFinalizationListclassPROTOTYPEhasNewFinalization
> + ^ false!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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]!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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"!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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"!
>
> Item was changed:
> ----- 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"!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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]]!
>
> Item was changed:
> ----- 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: ']]]!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was added:
> + ----- Method: SpurBootstrapPrototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
> + BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
> + <indirect>!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEsizeCallPrimitive: (in category 'method prototypes') -----
> BytecodeEncoderPROTOTYPEsizeCallPrimitive: primitiveIndex
> ^self sizeOpcodeSelector: #genCallPrimitive: withArguments: {primitiveIndex}!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasInteger (in category 'method prototypes') -----
> CharacterPROTOTYPEasInteger
> "Answer the receiver's character code."
> <primitive: 171>
> ^self primitiveFailed!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEcopy (in category 'method prototypes') -----
> CharacterPROTOTYPEcopy
> "Answer the receiver, because Characters are unique."
> ^self!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEdeepCopy (in category 'method prototypes') -----
> CharacterPROTOTYPEdeepCopy
> "Answer the receiver, because Characters are unique."
> ^self!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEhash (in category 'method prototypes') -----
> CharacterPROTOTYPEhash
> "Hash is reimplemented because = is implemented.
> Answer the receiver's character code."
> <primitive: 171>
> ^self primitiveFailed!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEidentityHash (in category 'method prototypes') -----
> CharacterPROTOTYPEidentityHash
> "Answer the receiver's character code."
> <primitive: 171>
> ^self primitiveFailed!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
> CharacterPROTOTYPEveryDeepCopyWith: deepCopier
> "Answer the receiver, because Characters are unique."
> ^self!
>
> Item was changed:
> ----- 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])!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
> CharacterclassPROTOTYPEinitialize
> "Create the DigitsValues table."
> "Character initialize"
> self initializeDigitValues!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEvalue: (in category 'method prototypes') -----
> CharacterclassPROTOTYPEvalue: anInteger
> "Answer the Character whose value is anInteger."
> <primitive: 170>
> ^self primitiveFailed!
>
> Item was changed:
> ----- 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.
> - 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"!
>
> Item was changed:
> ----- 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]!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category 'method prototypes') -----
> CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
> <indirect>!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinitialize (in category 'method prototypes') -----
> CompiledMethodclassPROTOTYPEinitialize "CompiledMethod initialize"
> <indirect>!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category 'method prototypes') -----
> CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
> <indirect>!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: (in category 'method prototypes') -----
> CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: aBytecodeEncoderSubclass
> <indirect>!
>
> Item was changed:
> ----- 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>!
>
> Item was changed:
> ----- 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>!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
> EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
> <remove>!
>
> Item was changed:
> ----- 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>!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode (in category 'method prototypes') -----
> EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode
> "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
> ^139!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEbasicNew (in category 'method prototypes') -----
> FloatclassPROTOTYPEbasicNew
> ^BoxedFloat64 basicNew: 2!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEbasicNew: (in category 'method prototypes') -----
> FloatclassPROTOTYPEbasicNew: anInteger
> ^BoxedFloat64 basicNew: 2!
>
> Item was changed:
> ----- 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."!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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>!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEasCharacter (in category 'method prototypes') -----
> SmallIntegerPROTOTYPEasCharacter
> <primitive: 170>
> ^self primitiveFailed!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEcompactClassesArray (in category 'method prototypes') -----
> SmalltalkImagePROTOTYPEcompactClassesArray
> "Smalltalk compactClassesArray"
> "Backward-compatibility support. Spur does not have compact classes."
> ^{}!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
> SmalltalkImagePROTOTYPEmaxIdentityHash
> "Answer the maximum identityHash value supported by the VM."
> <primitive: 176>
> ^self primitiveFailed!
>
> Item was changed:
> ----- 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 }!
>
> Item was changed:
> ----- 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]!
>
> Item was changed:
> ----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
> SystemDictionaryPROTOTYPEmaxIdentityHash
> "Answer the maximum identityHash value supported by the VM."
> <primitive: 176>
> ^self primitiveFailed!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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]]!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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]]!
>
> Item was changed:
> ----- 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]!
>
> Item was changed:
> ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEinterpretExtension:in:for: (in category 'method prototypes') -----
> InstructionStreamPROTOTYPEinterpretExtension: offset in: method for: client
> ^self interpretV3ClosuresExtension: offset in: method for: client!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- Method: SpurBootstrapSqueakFamilyPrototypes>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
> InstructionPrinterPROTOTYPEcallPrimitive: index
> "Print the callPrimitive."
>
> self print: 'callPrimtive: ' , index printString!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- Method: SpurBootstrapSqueakPrototypes>>CharacterPROTOTYPEclone (in category 'method prototypes') -----
> CharacterPROTOTYPEclone
> "Answer the receiver, because Characters are unique."
> ^self!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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])!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- Method: SpurBootstrapSqueakPrototypes>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') -----
> IntegerclassPROTOTYPEinitialize
> "Integer initialize"
> self initializeLowBitPerByteTable!
>
> Item was changed:
> ----- 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!
>
> Item was changed:
> ----- 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]!
>
> Item was changed:
> ----- 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"!
>
> Item was changed:
> ----- 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"!
>
> Item was changed:
> ----- 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"!
>
More information about the Vm-dev
mailing list