Vm-dev October 2014

vm-dev@lists.squeakfoundation.org

38 participants
133 discussions

VM Maker: Cog.pharo-EstebanLorenzano.216.mcz
by commits＠source.squeak.org 30 Oct '14

30 Oct '14

Esteban Lorenzano uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog.pharo-EstebanLorenzano.216.mcz ==================== Summary ==================== Name: Cog.pharo-EstebanLorenzano.216 Author: EstebanLorenzano Time: 30 October 2014, 5:02:17.704066 pm UUID: ec38e71a-0042-49e8-8844-37c3e1a2a2f0 Ancestors: Cog-EstebanLorenzano.215 =============== Diff against Cog-eem.212 =============== 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 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 added: + ----- Method: Context>>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 added: + ----- Method: Context>>xrayIsDivorced (in category '*Cog-Tests-xrays') ----- + xrayIsDivorced + ^(self xray bitAnd: 3) = 1! Item was added: + ----- Method: Context>>xrayIsExecutingMachineCode (in category '*Cog-Tests-xrays') ----- + xrayIsExecutingMachineCode + ^self xray anyMask: 4! Item was added: + ----- Method: Context>>xrayIsMarried (in category '*Cog-Tests-xrays') ----- + xrayIsMarried + ^self xray anyMask: 2! Item was added: + ----- Method: Context>>xrayLastExecutedMachineCode (in category '*Cog-Tests-xrays') ----- + xrayLastExecutedMachineCode + ^self xray anyMask: 8! Item was added: + ----- Method: Context>>xrayMethodIsCompiledToMachineCode (in category '*Cog-Tests-xrays') ----- + xrayMethodIsCompiledToMachineCode + ^self xray anyMask: 16! 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: InstructionStream>>InstructionStreamPROTOTYPEskipCallPrimitive (in category '*Cog-method prototypes') ----- InstructionStreamPROTOTYPEskipCallPrimitive "If the receiver's method starts with a callPrimitive: bytecode, skip it." | method encoderClass callPrimitiveCode | method := self method. encoderClass := method encoderClass. callPrimitiveCode := encoderClass callPrimitiveCode. (method byteAt: pc) = callPrimitiveCode ifTrue: [pc := pc + (encoderClass bytecodeSize: callPrimitiveCode)]! 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 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 | oldCompilerClass := SmalltalkImage compilerClass. + oldBytecodeBackend := CompilationContext bytecodeBackend. [ SmalltalkImage compilerClass: Compiler. + CompilationContext bytecodeBackend: IRSpurSqueakV3PlusClosuresBytecodeGenerator. self bootstrapImage: imageFileBaseName type: 'pharo' ] + ensure: [ + SmalltalkImage compilerClass: oldCompilerClass. + CompilationContext bytecodeBackend: oldBytecodeBackend ]! - ensure: [ SmalltalkImage compilerClass: oldCompilerClass ]. - ! 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>>prototypeClassNameMetaSelectorMethodDo: (in category 'method prototypes') ----- prototypeClassNameMetaSelectorMethodDo: quaternaryBlock "Evaluate aBlock with class name, class is meta, method and selector. For now find methods in class-side category #'method prototypes'. Scheme could be extended to have different protocols for different Squeak/Pharo versions." self allMethodPrototypes do: + [:eachMethod| | method className isMeta | + method := eachMethod. - [:method| | className isMeta | className := self classNameForPrototypeMethod: method. (isMeta := className endsWith: 'class') ifTrue: [className := (className allButLast: 5) asSymbol]. (method pragmaAt: #indirect) ifNotNil: [method := (isMeta ifTrue: [(Smalltalk classNamed: className) class] ifFalse: [Smalltalk classNamed: className]) >> method selector]. quaternaryBlock value: className value: isMeta value: (self selectorForPrototypeMethod: method) value: method]! Item was added: + ----- Method: SpurBootstrapMonticelloPackagePatcher>>updateTrunkRepository (in category 'repository population') ----- + updateTrunkRepository + "Download all the Collections, Kernel and System packages from trunk into srcDir, + patch them into destDir, + upload the patched and branched files that aren't already in trunk to trunk." + "self new from: 'trunkpackages' to: 'spurpackages'; updateTrunkRepository" + "AndreasSystemProfiler spyOn: [self new from: 'trunkpackages' to: 'spurpackages'; updateSpurRepository]" + sourceDir assureExistence. + self download: self class squeak45baseline from: self trunk. + destDir assureExistence. + self patchAsNeeded. + self uploadFrom: (MCDirectoryRepository directory: destDir) to: self trunk! Item was added: + ----- Method: SpurBootstrapMonticelloPackagePatcher>>versionFor: (in category 'patching') ----- + versionFor: packageFileName + ^sourceDir + readOnlyFileNamed: packageFileName + do: [:fs| + ((MCVersionReader readerClassForFileNamed: fs fullName) + on: fs fileName: fs fullName) + version]! Item was added: + SpurBootstrapPrototypes subclass: #SpurBootstrapOldSqueakPrototypes + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Cog-Bootstrapping'! Item was added: + ----- Method: SpurBootstrapOldSqueakPrototypes class>>imageType (in category 'accessing') ----- + imageType + ^ 'old squeak'! Item was added: + ----- Method: SpurBootstrapOldSqueakPrototypes>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category '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: 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 changed: ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEcodePoint (in category 'method prototypes') ----- CharacterPROTOTYPEcodePoint "Just for ANSI Compliance" ^self! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') ----- CharacterPROTOTYPEsetValue: newValue self error: 'Characters are immutable'! Item was added: + ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') ----- + CharacterPROTOTYPEshallowCopy + "Answer the receiver, because Characters are unique." + ^self! 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 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: 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 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 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>>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: SpurBootstrapPrototypes>>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: SpurBootstrapPrototypes>>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: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEnumLiterals (in category 'method prototypes') ----- CompiledMethodPROTOTYPEnumLiterals "Answer the number of literals used by the receiver." ^self header bitAnd: 65535! 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>>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>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') ----- InstructionPrinterPROTOTYPEcallPrimitive: index "Print the callPrimitive." self print: 'callPrimtive: ' , index printString! 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 added: + ----- Method: SpurBootstrapPrototypes>>categoryForClass:meta:selector: (in category 'method prototype categorization') ----- + categoryForClass: className meta: isMeta selector: selector + ^(isMeta + ifTrue: [{ className. #class. selector }] + ifFalse: [{ className. selector }]) + caseOf: { + [#(Behavior allInstancesOrNil)] -> [#enumerating]. + [#(Behavior byteSizeOfInstance)] -> [#'accessing instances and variables']. + [#(Behavior byteSizeOfInstanceOfSize:)] -> [#'accessing instances and variables']. + [#(Behavior elementSize)] -> [#'accessing instances and variables']. + [#(Behavior handleFailingBasicNew)] -> [#private]. + [#(Behavior handleFailingBasicNew:)] -> [#private]. + [#(Behavior handleFailingFailingBasicNew)] -> [#private]. + [#(Behavior handleFailingFailingBasicNew:)] -> [#private]. + [#(Behavior identityHash)] -> [#comparing]. + [#(Behavior isEphemeronClass)] -> [#testing]. + [#(Behavior isImmediateClass)] -> [#testing]. + [#(Character identityHash)] -> [#comparing]. + [#(Class immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)] + -> [#'subclass creation']. + [#(ClassBuilder superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)] + -> [#public]. + [#(CompiledMethod class handleFailingFailingNewMethod:header:)] + -> [#private]. + [#(CompiledMethod class handleFailingNewMethod:header:)] + -> [#private]. + [#(Context class allInstances)] -> [#enumerating]. + [#(Context class allInstancesDo:)] -> [#enumerating]. + [#(Context failPrimitiveWith:)] -> [#'system simulation']. + [#(Context isPrimFailToken:)] -> [#private]. + [#(Context send:to:with:lookupIn:)] -> [#controlling]. + [#(Context isPrimFailToken:)] -> [#private]. + [#(Context send:to:with:lookupIn:)] -> [#controlling]. + [#(CompiledMethod class headerFlagForEncoder:)] + -> [#'method encoding']. + [#(CompiledMethod class installPrimaryBytecodeSet:)] + -> [#'class initialization']. + [#(CompiledMethod class installSecondaryBytecodeSet:)] + -> [#'class initialization']. + [#(EncoderForV3PlusClosures genCallPrimitive:)] + -> [#'bytecode generation']. + [#(EncoderForV3PlusClosures class callPrimitiveCode)] + -> [#'bytecode decoding']. + [#(Context failPrimitiveWith:)] -> [#'system simulation']. + [#(Context class allInstances)] -> [#enumerating]. + [#(Context class allInstancesDo:)] -> [#enumerating]. + [#(SmallInteger asCharacter)] -> [#converting]. + [#(SmalltalkImage growMemoryByAtLeast:)] -> [#'memory space']. + [#(SmalltalkImage maxIdentityHash)] -> [#'system attributes']. + [#(SystemDictionary growMemoryByAtLeast:)] -> [#'memory space']. + [#(SystemDictionary maxIdentityHash)] -> [#'system attributes']. + [#(SystemDictionary setGCParameters)] -> [#'snapshot and quit']. + [#(SystemNavigation allObjects)] -> [#query]. + [#(SystemNavigation allObjectsOrNil)] -> [#query]. + } + otherwise: + [Transcript nextPutAll: className. + isMeta ifTrue: [Transcript nextPutAll: ' class']. + Transcript nextPutAll: '>>'; store: selector; nextPutAll: ' is unclassified'; cr; flush. + ^Categorizer default]! 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: 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"!

1 0

[commit][3117] CogVM source as per VMMaker.oscog-eem.914
by commits＠squeakvm.org 30 Oct '14

30 Oct '14

Revision: 3117 Author: eliot Date: 2014-10-29 16:58:59 -0700 (Wed, 29 Oct 2014) Log Message: ----------- CogVM source as per VMMaker.oscog-eem.914 Spur: Implement safe access to contexts and methods when creating image segments (since internally married contexts and jitted methods have hidden state encoded in odd ways). As a result: Fix baaad bug in SpurMemoryManager>>lastPointerOf: for contexts, caused by transcription from (New)ObjectMemory where the method works on a wing and a prayer because BaseHeaderSize = BytesPerOop. And I can't be arsed to fix it. Refactor decoding of context instruction pointers so there is only one copy of the code. Fix baaad bug in accessibleObjectAfter: and add an assert to primitiveNextObject to catch similar bugs. Can now enumerate objects in new space, which will sort-of work, but code should really use allObjects. Will fix at the image level as time allows. Eliminate isInSurvivorSpace: in favour of the identical isInPastSpace:. All: Fix the comments in loadImageSegmentFrom:outPointers:; the array is not truncated to zero length; it retains its version info. Fix storeShort16:ofObject:withValue: to accept negative values. Modified Paths: -------------- branches/Cog/image/uploadspurimage.sh branches/Cog/nscogsrc/vm/cointerp.c branches/Cog/nscogsrc/vm/cointerp.h branches/Cog/nscogsrc/vm/gcc3x-cointerp.c branches/Cog/nsspursrc/vm/cointerp.c branches/Cog/nsspursrc/vm/cointerp.h branches/Cog/nsspursrc/vm/gcc3x-cointerp.c branches/Cog/nsspurstacksrc/vm/gcc3x-interp.c branches/Cog/nsspurstacksrc/vm/interp.c branches/Cog/sistasrc/vm/cointerp.c branches/Cog/sistasrc/vm/cointerp.h branches/Cog/sistasrc/vm/gcc3x-cointerp.c branches/Cog/spursistasrc/vm/cointerp.c branches/Cog/spursistasrc/vm/cointerp.h branches/Cog/spursistasrc/vm/gcc3x-cointerp.c branches/Cog/spursrc/vm/cointerp.c branches/Cog/spursrc/vm/cointerp.h branches/Cog/spursrc/vm/gcc3x-cointerp.c branches/Cog/spurstacksrc/vm/gcc3x-interp.c branches/Cog/spurstacksrc/vm/interp.c branches/Cog/src/plugins/ADPCMCodecPlugin/ADPCMCodecPlugin.c branches/Cog/src/plugins/SoundGenerationPlugin/SoundGenerationPlugin.c branches/Cog/src/vm/cointerp.c branches/Cog/src/vm/cointerp.h branches/Cog/src/vm/cointerpmt.c branches/Cog/src/vm/cointerpmt.h branches/Cog/src/vm/gcc3x-cointerp.c branches/Cog/src/vm/gcc3x-cointerpmt.c branches/Cog/stacksrc/vm/gcc3x-interp.c branches/Cog/stacksrc/vm/interp.c Property Changed: ---------------- branches/Cog/platforms/Cross/vm/sqSCCSVersion.h Modified: branches/Cog/image/uploadspurimage.sh =================================================================== --- branches/Cog/image/uploadspurimage.sh 2014-10-27 18:59:12 UTC (rev 3116) +++ branches/Cog/image/uploadspurimage.sh 2014-10-29 23:58:59 UTC (rev 3117) @@ -6,8 +6,10 @@ " DATE=`date +%Y-%m-%d` BASENAME=trunk46-spur -cd `dirname $0` +test "$1" = -here || cd `dirname $0` +echo uploading trunk46-spur from `pwd` + DIR=$RemoteRoot/$DATE echo ssh -x $RemoteUser mkdir $DIR ssh -x $RemoteUser mkdir $DIR @@ -19,4 +21,4 @@ ssh $RemoteUser rm $RemoteRoot/{$BASENAME.image,$BASENAME.changes} echo ssh $RemoteUser cd $RemoteRoot \\\; ln -s $DATE/{$BASENAME.image,$BASENAME.changes} . ssh $RemoteUser cd $RemoteRoot \; ln -s $DATE/{$BASENAME.image,$BASENAME.changes} . -ssh $RemoteUser ls -l $RemoteRoot +ssh $RemoteUser ls -l $RemoteRoot $RemoteRoot/$DATE Modified: branches/Cog/nscogsrc/vm/cointerp.c =================================================================== --- branches/Cog/nscogsrc/vm/cointerp.c 2014-10-27 18:59:12 UTC (rev 3116) +++ branches/Cog/nscogsrc/vm/cointerp.c 2014-10-29 23:58:59 UTC (rev 3117) @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.913 uuid: 236b8f3e-0ff4-4a68-baf9-e3fc62b97da7 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.914 uuid: bda96e1c-f22e-4b32-9ee1-620740e1fec5 from - CoInterpreter VMMaker.oscog-eem.913 uuid: 236b8f3e-0ff4-4a68-baf9-e3fc62b97da7 + CoInterpreter VMMaker.oscog-eem.914 uuid: bda96e1c-f22e-4b32-9ee1-620740e1fec5 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.913 uuid: 236b8f3e-0ff4-4a68-baf9-e3fc62b97da7 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.914 uuid: bda96e1c-f22e-4b32-9ee1-620740e1fec5 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -465,6 +465,7 @@ void ifValidWriteBackStackPointersSaveTo(void *theCFP, void *theCSP, char **savedFPP, char **savedSPP); sqInt implicitReceiverFormixinimplementing(sqInt rcvr, sqInt mixin, sqInt selector); usqInt instructionPointerAddress(void); +static sqInt instructionPointerForFramecurrentFPcurrentIP(sqInt spouseFP, sqInt currentFP, sqInt instrPtr) NoDbgRegParms; usqInt interpretAddress(void); static sqInt interpreterAllocationReserveBytes(void); static sqInt interpretMethodFromMachineCode(void); @@ -1066,6 +1067,7 @@ void * fetchArrayofObject(sqInt fieldIndex, sqInt objectPointer); double fetchFloatofObject(sqInt fieldIndex, sqInt objectPointer); sqInt fetchIntegerofObject(sqInt fieldIndex, sqInt objectPointer); +static sqInt fetchPointerofMarriedContext(sqInt offset, sqInt aContext) NoDbgRegParms; static sqInt fetchStackPointerOf(sqInt aContext) NoDbgRegParms; static sqInt findApplicationOfTargetMixinstartingAtBehavior(sqInt targetMixin, sqInt aBehavior) NoDbgRegParms; static sqInt findApplicationOfTargetMixinstartingAtNonMetaClass(sqInt targetMixin, sqInt aClass) NoDbgRegParms; @@ -1326,8 +1328,8 @@ _iss StackPage * stackPage; _iss sqInt bytecodeSetSelector; _iss usqInt freeStart; -_iss usqInt instructionPointer; _iss sqInt argumentCount; +_iss usqInt instructionPointer; _iss sqInt nilObj; _iss usqInt newMethod; _iss sqInt messageSelector; @@ -2085,7 +2087,7 @@ /* 574 */ (void (*)(void))0, /* 575 */ (void (*)(void))0, 0 }; -const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreterPrimitives_VMMaker.oscog-eem.913"; +const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreterPrimitives_VMMaker.oscog-eem.914"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; volatile int sendTrace; @@ -4384,7 +4386,7 @@ ? ((longAt(localFP + FoxMethod)) & MFMethodFlagIsBlockFlag) != 0 : (byteAt((localFP + FoxIFrameFlags) + 3)) != 0))) { goto commonCallerReturn; - goto l298; + goto l296; } closure = longAt(localFP + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(localFP + FoxMethod)))) < (startOfMemory()) ? ((mframeCogMethod(localFP))->cmNumArgs) @@ -4421,11 +4423,11 @@ theMethod = longAt((home + BaseHeaderSize) + (MethodIndex << ShiftForWord)); if ((primitiveIndexOfMethodheader(theMethod, methodHeaderOf(theMethod))) == 198) { unwindContextOrNilOrZero = home; - goto l300; + goto l298; } } unwindContextOrNilOrZero = ctxtOrNilOrZero; - l300: /* end internalFindUnwindThroughContext: */; + l298: /* end internalFindUnwindThroughContext: */; if (unwindContextOrNilOrZero == GIV(nilObj)) { /* error: can't find home on chain; cannot return */ @@ -4439,10 +4441,10 @@ : (byteAt((localFP + FoxIFrameFlags) + 2)) != 0)) { assert(isContext(frameContext(localFP))); ourContext = longAt(localFP + FoxThisContext); - goto l302; + goto l300; } ourContext = marryFrameSP(localFP, localSP); - l302: /* end ensureFrameIsMarried:SP: */; + l300: /* end ensureFrameIsMarried:SP: */; /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), ourContext); /* begin internalPush: */ @@ -4451,7 +4453,7 @@ GIV(argumentCount) = 1; goto normalSend; /* return self */ - goto l298; + goto l296; } if (unwindContextOrNilOrZero != 0) { /* begin internalAboutToReturn:through: */ @@ -4463,10 +4465,10 @@ : (byteAt((localFP + FoxIFrameFlags) + 2)) != 0)) { assert(isContext(frameContext(localFP))); ourContext1 = longAt(localFP + FoxThisContext); - goto l299; + goto l297; } ourContext1 = marryFrameSP(localFP, localSP); - l299: /* end ensureFrameIsMarried:SP: */; + l297: /* end ensureFrameIsMarried:SP: */; /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), ourContext1); /* begin internalPush: */ @@ -4477,7 +4479,7 @@ GIV(argumentCount) = 2; goto normalSend; /* return self */ - goto l298; + goto l296; } contextToReturnTo = null; if (((longAt((home + BaseHeaderSize) + (SenderIndex << ShiftForWord))) & 1)) { @@ -4536,10 +4538,10 @@ : (byteAt((localFP + FoxIFrameFlags) + 2)) != 0)) { assert(isContext(frameContext(localFP))); ourContext2 = longAt(localFP + FoxThisContext); - goto l301; + goto l299; } ourContext2 = marryFrameSP(localFP, localSP); - l301: /* end ensureFrameIsMarried:SP: */; + l299: /* end ensureFrameIsMarried:SP: */; /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), ourContext2); /* begin internalPush: */ @@ -4548,7 +4550,7 @@ GIV(argumentCount) = 1; goto normalSend; /* return self */ - goto l298; + goto l296; } } assert(pageListIsWellFormed()); @@ -4659,7 +4661,7 @@ GIV(framePointer) = localFP; ceEnterCogCodePopReceiverReg(); - goto l298; + goto l296; } localIP = pointerForOop(longAt(localFP + FoxIFSavedIP)); } @@ -4677,7 +4679,7 @@ /* return self */ } - l298: /* end case */; + l296: /* end case */; break; case 121: /* returnTrue */ @@ -4797,27 +4799,27 @@ fp = (thePage->headFP); if (fp == theFP) { frameAbove = 0; - goto l305; + goto l303; } while (((callerFP = frameCallerFP(fp))) != 0) { if (callerFP == theFP) { frameAbove = fp; - goto l305; + goto l303; } fp = callerFP; } error("did not find theFP in stack page"); frameAbove = 0; - l305: /* end findFrameAbove:inPage: */; + l303: /* end findFrameAbove:inPage: */; /* begin newStackPage */ lruOrFree = ((mostRecentlyUsedPage())->nextPage); if (isFree(lruOrFree)) { newPage = lruOrFree; - goto l306; + goto l304; } divorceFramesIn(lruOrFree); newPage = lruOrFree; - l306: /* end newStackPage */; + l304: /* end newStackPage */; assert(newPage == GIV(stackPage)); moveFramesInthroughtoPage(thePage, frameAbove, newPage); markStackPageMostRecentlyUsed(newPage); @@ -4841,7 +4843,7 @@ longAtput((sp2 = GIV(stackPointer) - BytesPerWord), GIV(instructionPointer)); GIV(stackPointer) = sp2; ceSendAborttonumArgs(longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorCannotReturn << ShiftForWord)), contextToReturnFrom, 1); - goto l304; + goto l302; } GIV(instructionPointer) = 0; thePage = makeBaseFrameFor(contextToReturnTo); @@ -4880,7 +4882,7 @@ GIV(framePointer) = localFP; ceEnterCogCodePopReceiverReg(); - goto l304; + goto l302; } localIP = pointerForOop(longAt(localFP + FoxIFSavedIP)); } @@ -4898,8 +4900,8 @@ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); /* return self */ - l304: /* end baseFrameReturn */; - goto l303; + l302: /* end baseFrameReturn */; + goto l301; } /* begin frameCallerSavedIP: */ localIP = pointerForOop(longAt(localFP + FoxCallerSavedIP)); @@ -4928,7 +4930,7 @@ GIV(framePointer) = localFP; ceEnterCogCodePopReceiverReg(); - goto l303; + goto l301; } localIP = pointerForOop(longAt(localFP + FoxIFSavedIP)); } @@ -4945,7 +4947,7 @@ longAtPointerput(localSP, localReturnValue); } - l303: /* end case */; + l301: /* end case */; break; case 126: /* dynamicSuperSendBytecode */ @@ -5237,7 +5239,7 @@ GIV(newMethod) = GIV(methodCache)[probe + MethodCacheMethod]; primitiveFunctionPointer = ((void (*)()) (GIV(methodCache)[probe + MethodCachePrimFunction])); ok = 1; - goto l310; + goto l308; } /* second probe */ @@ -5248,7 +5250,7 @@ GIV(newMethod) = GIV(methodCache)[probe + MethodCacheMethod]; primitiveFunctionPointer = ((void (*)()) (GIV(methodCache)[probe + MethodCachePrimFunction])); ok = 1; - goto l310; + goto l308; } probe = (((usqInt) hash) >> 2) & MethodCacheMask; if (((GIV(methodCache)[probe + MethodCacheSelector]) == GIV(messageSelector)) @@ -5256,10 +5258,10 @@ GIV(newMethod) = GIV(methodCache)[probe + MethodCacheMethod]; primitiveFunctionPointer = ((void (*)()) (GIV(methodCache)[probe + MethodCachePrimFunction])); ok = 1; - goto l310; + goto l308; } ok = 0; - l310: /* end inlineLookupInMethodCacheSel:classTag: */; + l308: /* end inlineLookupInMethodCacheSel:classTag: */; if (ok) { /* begin ifAppropriateCompileToNativeCode:selector: */ methodHeader2 = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << ShiftForWord)); @@ -5297,7 +5299,7 @@ localFP = pointerForOop(GIV(framePointer)); addNewMethodToCache(GIV(lkupClass)); } - l307: /* end internalFindNewMethod */; + l305: /* end internalFindNewMethod */; /* begin internalExecuteNewMethod */ VM_LABEL(0internalExecuteNewMethod); if (primitiveFunctionPointer != 0) { @@ -5311,31 +5313,31 @@ if (localPrimIndex >= 264) { longAtPointerput(localSP, longAt(((longAtPointer(localSP)) + BaseHeaderSize) + ((localPrimIndex - 264) << ShiftForWord))); 1; - goto l311; + goto l309; } if (localPrimIndex == 256) { 1; - goto l311; + goto l309; } if (localPrimIndex == 257) { longAtPointerput(localSP, GIV(trueObj)); 1; - goto l311; + goto l309; } if (localPrimIndex == 258) { longAtPointerput(localSP, GIV(falseObj)); 1; - goto l311; + goto l309; } if (localPrimIndex == 259) { longAtPointerput(localSP, GIV(nilObj)); 1; - goto l311; + goto l309; } longAtPointerput(localSP, (((localPrimIndex - 261) << 1) | 1)); 1; - l311: /* end internalQuickPrimitiveResponse */; - goto l309; + l309: /* end internalQuickPrimitiveResponse */; + goto l307; } /* begin externalizeIPandSP */ assert((((usqInt)localIP)) != (ceReturnToInterpreterPC())); @@ -5394,7 +5396,7 @@ returntoExecutive(popStack(), 1); browserPluginReturnIfNeeded(); null; - goto l309; + goto l307; } } if (methodHasCogMethod(GIV(newMethod))) { @@ -5475,11 +5477,11 @@ table = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (PrimErrTableIndex << ShiftForWord)); if (GIV(primFailCode) <= ((lastPointerOf(table)) / BytesPerWord)) { errorCode = longAt((table + BaseHeaderSize) + ((GIV(primFailCode) - 1) << ShiftForWord)); - goto l308; + goto l306; } } errorCode = ((GIV(primFailCode) << 1) | 1); - l308: /* end getErrorObjectFromPrimFailCode */; + l306: /* end getErrorObjectFromPrimFailCode */; longAtPointerput(localSP, errorCode); } GIV(primFailCode) = 0; @@ -5503,7 +5505,7 @@ localFP = pointerForOop(GIV(framePointer)); } } - l309: /* end internalExecuteNewMethod */; + l307: /* end internalExecuteNewMethod */; /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); @@ -5517,11 +5519,8 @@ sqInt byte3; sqInt callerContextOrNil; char *callerFP; - char *callerFP1; - char *fp; sqInt index; sqInt index1; - sqInt index2; sqInt litVar; sqInt litVar1; sqInt object; @@ -5533,16 +5532,12 @@ sqInt rcvr; sqInt rcvr1; sqInt result; - sqInt result1; sqInt senderOop; sqInt senderOop1; char *spouseFP; char *theFP; - char *theFPAbove; - sqInt theIP; StackPage *thePage; StackPage *thePage1; - StackPage *thePage2; char *theSP; sqInt top; sqInt value; @@ -5557,7 +5552,7 @@ GIV(messageSelector) = longAt((GIV(method) + BaseHeaderSize) + ((byte3 + LiteralStart) << ShiftForWord)); GIV(argumentCount) = byte2 & 0x1F; goto normalSend; - goto l5; + goto l4; } if (opType == 1) { /* begin literal: */ @@ -5565,7 +5560,7 @@ GIV(messageSelector) = longAt((GIV(method) + BaseHeaderSize) + ((byte3 + LiteralStart) << ShiftForWord)); GIV(argumentCount) = byte2 & 0x1F; goto superclassSend; - goto l5; + goto l4; } /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); @@ -5612,11 +5607,11 @@ value = result; } object1 = value; - goto l8; + goto l6; } if (isWidowedContext(rcvr)) { object1 = longAt((rcvr + BaseHeaderSize) + (byte3 << ShiftForWord)); - goto l8; + goto l6; } /* begin frameOfMarriedContext: */ senderOop = longAt((rcvr + BaseHeaderSize) + (SenderIndex << ShiftForWord)); @@ -5626,8 +5621,8 @@ if (byte3 == SenderIndex) { /* begin ensureCallerContext: */ /* begin frameCallerFP: */ - callerFP1 = pointerForOop(longAt(spouseFP + FoxSavedFP)); - if (callerFP1 == 0) { + callerFP = pointerForOop(longAt(spouseFP + FoxSavedFP)); + if (callerFP == 0) { /* base frame, context in saved ip slot (or base of stack in Cog) */ @@ -5637,14 +5632,14 @@ /* begin stackPageAt: */ /* begin pageIndexFor: */ assert((((((char *) spouseFP)) >= (GIV(stackBasePlus1) - 1)) && ((((char *) spouseFP)) <= (((char *) GIV(pages)))))); - index2 = pageIndexForstackBasePlus1bytesPerPage(spouseFP, GIV(stackBasePlus1), GIV(bytesPerPage)); - thePage2 = stackPageAtpages(index2, GIV(pages)); - callerContextOrNil = longAt((thePage2->baseAddress)); + index = pageIndexForstackBasePlus1bytesPerPage(spouseFP, GIV(stackBasePlus1), GIV(bytesPerPage)); + thePage1 = stackPageAtpages(index, GIV(pages)); + callerContextOrNil = longAt((thePage1->baseAddress)); assert(addressCouldBeObj(callerContextOrNil)); assert((callerContextOrNil == (nilObject())) || (isContext(callerContextOrNil))); object1 = callerContextOrNil; - goto l4; + goto l5; } /* begin ensureFrameIsMarried:SP: */ VM_LABEL(3ensureFrameIsMarriedSP); @@ -5653,82 +5648,36 @@ theSP = (spouseFP + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(spouseFP + FoxMethod)))) < (startOfMemory()) ? ((mframeCogMethod(spouseFP))->cmNumArgs) : byteAt((spouseFP + FoxIFrameFlags) + 1))))) + BytesPerWord; - if (((((usqInt)(longAt(callerFP1 + FoxMethod)))) < (startOfMemory()) - ? ((longAt(callerFP1 + FoxMethod)) & MFMethodFlagHasContextFlag) != 0 - : (byteAt((callerFP1 + FoxIFrameFlags) + 2)) != 0)) { - assert(isContext(frameContext(callerFP1))); - object1 = longAt(callerFP1 + FoxThisContext); - goto l4; + if (((((usqInt)(longAt(callerFP + FoxMethod)))) < (startOfMemory()) + ? ((longAt(callerFP + FoxMethod)) & MFMethodFlagHasContextFlag) != 0 + : (byteAt((callerFP + FoxIFrameFlags) + 2)) != 0)) { + assert(isContext(frameContext(callerFP))); + object1 = longAt(callerFP + FoxThisContext); + goto l5; } - object1 = marryFrameSP(callerFP1, theSP); - l4: /* end ensureCallerContext: */; - goto l8; + object1 = marryFrameSP(callerFP, theSP); + l5: /* end ensureCallerContext: */; + goto l6; } if (byte3 == StackPointerIndex) { assert((ReceiverIndex + (stackPointerIndexForFrame(spouseFP))) < (lengthOf(rcvr))); object1 = (((stackPointerIndexForFrame(spouseFP)) << 1) | 1); - goto l8; + goto l6; } if (byte3 == InstructionPointerIndex) { - if (spouseFP == localFP) { - theIP = oopForPointer(localIP); - } - else { - /* begin stackPageFor: */ - /* begin stackPageAt: */ - /* begin pageIndexFor: */ - assert((((((char *) spouseFP)) >= (GIV(stackBasePlus1) - 1)) && ((((char *) spouseFP)) <= (((char *) GIV(pages)))))); - index = pageIndexForstackBasePlus1bytesPerPage(spouseFP, GIV(stackBasePlus1), GIV(bytesPerPage)); - thePage = stackPageAtpages(index, GIV(pages)); - /* begin findFrameAbove:inPage: */ - fp = (thePage->headFP); - if (fp == spouseFP) { - theFPAbove = 0; - goto l7; - } - while (((callerFP = frameCallerFP(fp))) != 0) { - if (callerFP == spouseFP) { - theFPAbove = fp; - goto l7; - } - fp = callerFP; - } - error("did not find theFP in stack page"); - theFPAbove = 0; - l7: /* end findFrameAbove:inPage: */; - theIP = (theFPAbove == 0 - ? longAt((thePage->headSP)) - : oopForPointer(frameCallerSavedIP(theFPAbove))); - } - value = contextInstructionPointerframe(theIP, spouseFP); - if ((((sqInt) value)) < 0) { - /* begin internalMustMapMachineCodePC:context: */ - /* begin externalizeIPandSP */ - assert((((usqInt)localIP)) != (ceReturnToInterpreterPC())); - GIV(instructionPointer) = oopForPointer(localIP); - GIV(stackPointer) = localSP; - GIV(framePointer) = localFP; - result1 = mustMapMachineCodePCcontext((value >> 1), rcvr); - /* begin internalizeIPandSP */ - assert(GIV(instructionPointer) != (ceReturnToInterpreterPC())); - localIP = pointerForOop(GIV(instructionPointer)); - localSP = pointerForOop(GIV(stackPointer)); - localFP = pointerForOop(GIV(framePointer)); - value = result1; - } - object1 = value; - goto l8; + object1 = instructionPointerForFramecurrentFPcurrentIP(spouseFP, localFP, localIP); + goto l6; } error("bad index"); object1 = 0; - l8: /* end instVar:ofContext: */; + l6: /* end instVar:ofContext: */; longAtPointerput((localSP -= BytesPerOop), object1); } else { /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), longAt((rcvr + BaseHeaderSize) + (byte3 << ShiftForWord))); } - goto l5; + goto l4; } if (opType == 3) { /* begin pushLiteralConstant: */ @@ -5737,7 +5686,7 @@ assert(GIV(method) == (iframeMethod(localFP))); object = longAt((GIV(method) + BaseHeaderSize) + ((byte3 + LiteralStart) << ShiftForWord)); longAtPointerput((localSP -= BytesPerOop), object); - goto l5; + goto l4; } if (opType == 4) { /* begin pushLiteralVariable: */ @@ -5750,7 +5699,7 @@ object2 = longAt((oop + BaseHeaderSize) + (ValueIndex << ShiftForWord)); longAtPointerput((localSP -= BytesPerOop), object2); - goto l5; + goto l4; } top = longAtPointer(localSP); if (opType == 7) { @@ -5764,7 +5713,7 @@ possibleRootStoreIntovalue(litVar, top); } longAtput((litVar + BaseHeaderSize) + (ValueIndex << ShiftForWord), top); - goto l5; + goto l4; } if (opType == 6) { /* begin internalPop: */ @@ -5802,7 +5751,7 @@ ensureContextIsExecutionSafeAfterAssignToStackPointer(rcvr1); } null; - goto l6; + goto l7; } /* begin frameOfMarriedContext: */ senderOop1 = longAt((rcvr1 + BaseHeaderSize) + (SenderIndex << ShiftForWord)); @@ -5815,9 +5764,9 @@ /* begin pageIndexFor: */ assert((((((char *) theFP)) >= (GIV(stackBasePlus1) - 1)) && ((((char *) theFP)) <= (((char *) GIV(pages)))))); index1 = pageIndexForstackBasePlus1bytesPerPage(theFP, GIV(stackBasePlus1), GIV(bytesPerPage)); - thePage1 = stackPageAtpages(index1, GIV(pages)); + thePage = stackPageAtpages(index1, GIV(pages)); assert(GIV(stackPage) == (mostRecentlyUsedPage())); - onCurrentPage = thePage1 == GIV(stackPage); + onCurrentPage = thePage == GIV(stackPage); storeSenderOfFramewithValue(theFP, top); if (onCurrentPage) { localFP = (GIV(stackPage)->headFP); @@ -5827,7 +5776,7 @@ markStackPageMostRecentlyUsed(GIV(stackPage)); } null; - goto l6; + goto l7; } /* begin externalizeIPandSP */ assert((((usqInt)localIP)) != (ceReturnToInterpreterPC())); @@ -5850,7 +5799,7 @@ localFP = pointerForOop(GIV(framePointer)); markStackPageMostRecentlyUsed(GIV(stackPage)); assertValidExecutionPointersimbarline(((usqInt)localIP), localFP, localSP, 1, __LINE__); - l6: /* end instVar:ofContext:put: */; + l7: /* end instVar:ofContext:put: */; } else { /* begin storePointer:ofObject:withValue: */ @@ -5860,7 +5809,7 @@ longAtput((rcvr1 + BaseHeaderSize) + (byte3 << ShiftForWord), top); } } - l5: /* end case */; + l4: /* end case */; break; case 133: /* singleExtendedSuperBytecode */ @@ -5950,10 +5899,10 @@ : (byteAt((theFP + FoxIFrameFlags) + 2)) != 0)) { assert(isContext(frameContext(theFP))); ourContext = longAt(theFP + FoxThisContext); - goto l9; + goto l8; } ourContext = marryFrameSP(theFP, theSP); - l9: /* end ensureFrameIsMarried:SP: */; + l8: /* end ensureFrameIsMarried:SP: */; /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); @@ -6141,10 +6090,10 @@ : (byteAt((theFP + FoxIFrameFlags) + 2)) != 0)) { assert(isContext(frameContext(theFP))); context = longAt(theFP + FoxThisContext); - goto l10; + goto l9; } context = marryFrameSP(theFP, theSP); - l10: /* end ensureFrameIsMarried:SP: */; + l9: /* end ensureFrameIsMarried:SP: */; /* begin closureIn:numArgs:instructionPointer:numCopiedValues: */ VM_LABEL(0closureInnumArgsinstructionPointernumCopiedValues); newClosure1 = eeInstantiateSmallClassnumSlots(longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassBlockClosure << ShiftForWord)), ClosureFirstCopiedValueIndex + numCopied); @@ -6321,7 +6270,7 @@ GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorMustBeBoolean << ShiftForWord)); GIV(argumentCount) = 0; goto normalSend; - goto l11; + goto l10; } /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); @@ -6329,7 +6278,7 @@ } /* begin internalPop: */ localSP += 1 * BytesPerOop; - l11: /* end jumplfFalseBy: */; + l10: /* end jumplfFalseBy: */; } break; case 160: @@ -6352,7 +6301,7 @@ /* begin ifBackwardsCheckForEvents: */ VM_LABEL(0ifBackwardsCheckForEvents); if (offset >= 0) { - goto l12; + goto l11; } if (localSP < GIV(stackLimit)) { /* begin externalizeIPandSP */ @@ -6369,7 +6318,7 @@ localSP = pointerForOop(GIV(stackPointer)); localFP = pointerForOop(GIV(framePointer)); if (switched) { - goto l12; + goto l11; } } backwardJumpCountByte = byteAt(localFP + ((VMBIGENDIAN @@ -6399,7 +6348,7 @@ byteAtput(localFP + ((VMBIGENDIAN ? (FoxIFrameFlags + BytesPerWord) - 1 : FoxIFrameFlags)), backwardJumpCountByte); - l12: /* end ifBackwardsCheckForEvents: */; + l11: /* end ifBackwardsCheckForEvents: */; /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); @@ -6431,7 +6380,7 @@ GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorMustBeBoolean << ShiftForWord)); GIV(argumentCount) = 0; goto normalSend; - goto l13; + goto l12; } /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); @@ -6439,7 +6388,7 @@ } /* begin internalPop: */ localSP += 1 * BytesPerOop; - l13: /* end jumplfTrueBy: */; + l12: /* end jumplfTrueBy: */; } break; case 172: @@ -6468,7 +6417,7 @@ GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorMustBeBoolean << ShiftForWord)); GIV(argumentCount) = 0; goto normalSend; - goto l14; + goto l13; } /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); @@ -6476,7 +6425,7 @@ } /* begin internalPop: */ localSP += 1 * BytesPerOop; - l14: /* end jumplfFalseBy: */; + l13: /* end jumplfFalseBy: */; } break; case 176: @@ -6506,7 +6455,7 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - goto l15; + goto l14; } } else { @@ -6521,77 +6470,77 @@ /* begin loadFloatOrIntFrom: */ if ((rcvr & 1)) { rcvr1 = ((double) ((rcvr >> 1)) ); - goto l19; + goto l18; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((rcvr & 1)) { isFloat = 0; - goto l18; + goto l17; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((rcvr & 1))); ccIndex = (((usqInt) (longAt(rcvr))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex == 0) { isFloat = ((longAt(rcvr - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l22; + goto l21; } isFloat = ClassFloatCompactIndex == ccIndex; - goto l22; + goto l21; isFloat = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord))); - l22: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l18: /* end is:instanceOf:compactClassIndex: */; + l21: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l17: /* end is:instanceOf:compactClassIndex: */; if (isFloat) { ; fetchFloatAtinto(rcvr + BaseHeaderSize, result1); rcvr1 = result1; - goto l17; + goto l16; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } rcvr1 = 0.0; - l17: /* end floatValueOf: */; - l19: /* end loadFloatOrIntFrom: */; + l16: /* end floatValueOf: */; + l18: /* end loadFloatOrIntFrom: */; /* begin loadFloatOrIntFrom: */ if ((arg & 1)) { arg1 = ((double) ((arg >> 1)) ); - goto l23; + goto l22; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((arg & 1)) { isFloat1 = 0; - goto l21; + goto l20; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((arg & 1))); ccIndex1 = (((usqInt) (longAt(arg))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex1 == 0) { isFloat1 = ((longAt(arg - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l16; + goto l15; } isFloat1 = ClassFloatCompactIndex == ccIndex1; - goto l16; + goto l15; isFloat1 = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex1 - 1) << ShiftForWord))); - l16: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l21: /* end is:instanceOf:compactClassIndex: */; + l15: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l20: /* end is:instanceOf:compactClassIndex: */; if (isFloat1) { ; fetchFloatAtinto(arg + BaseHeaderSize, result2); arg1 = result2; - goto l20; + goto l19; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } arg1 = 0.0; - l20: /* end floatValueOf: */; - l23: /* end loadFloatOrIntFrom: */; + l19: /* end floatValueOf: */; + l22: /* end loadFloatOrIntFrom: */; if (!GIV(primFailCode)) { /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((2 - 1) * BytesPerWord)), floatObjectOf(rcvr1 + arg1)); @@ -6606,14 +6555,14 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - goto l15; + goto l14; } } GIV(messageSelector) = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SpecialSelectors << ShiftForWord))) + BaseHeaderSize) + ((0 * 2) << ShiftForWord)); GIV(argumentCount) = 1; goto normalSend; } - l15: /* end case */; + l14: /* end case */; break; case 177: /* bytecodePrimSubtract */ @@ -6642,7 +6591,7 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - goto l24; + goto l23; } } else { @@ -6657,77 +6606,77 @@ /* begin loadFloatOrIntFrom: */ if ((rcvr & 1)) { rcvr1 = ((double) ((rcvr >> 1)) ); - goto l28; + goto l27; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((rcvr & 1)) { isFloat = 0; - goto l27; + goto l26; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((rcvr & 1))); ccIndex = (((usqInt) (longAt(rcvr))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex == 0) { isFloat = ((longAt(rcvr - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l31; + goto l30; } isFloat = ClassFloatCompactIndex == ccIndex; - goto l31; + goto l30; isFloat = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord))); - l31: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l27: /* end is:instanceOf:compactClassIndex: */; + l30: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l26: /* end is:instanceOf:compactClassIndex: */; if (isFloat) { ; fetchFloatAtinto(rcvr + BaseHeaderSize, result1); rcvr1 = result1; - goto l26; + goto l25; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } rcvr1 = 0.0; - l26: /* end floatValueOf: */; - l28: /* end loadFloatOrIntFrom: */; + l25: /* end floatValueOf: */; + l27: /* end loadFloatOrIntFrom: */; /* begin loadFloatOrIntFrom: */ if ((arg & 1)) { arg1 = ((double) ((arg >> 1)) ); - goto l32; + goto l31; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((arg & 1)) { isFloat1 = 0; - goto l30; + goto l29; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((arg & 1))); ccIndex1 = (((usqInt) (longAt(arg))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex1 == 0) { isFloat1 = ((longAt(arg - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l25; + goto l24; } isFloat1 = ClassFloatCompactIndex == ccIndex1; - goto l25; + goto l24; isFloat1 = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex1 - 1) << ShiftForWord))); - l25: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l30: /* end is:instanceOf:compactClassIndex: */; + l24: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l29: /* end is:instanceOf:compactClassIndex: */; if (isFloat1) { ; fetchFloatAtinto(arg + BaseHeaderSize, result2); arg1 = result2; - goto l29; + goto l28; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } arg1 = 0.0; - l29: /* end floatValueOf: */; - l32: /* end loadFloatOrIntFrom: */; + l28: /* end floatValueOf: */; + l31: /* end loadFloatOrIntFrom: */; if (!GIV(primFailCode)) { /* begin pop:thenPushFloat: */ longAtput((sp = GIV(stackPointer) + ((2 - 1) * BytesPerWord)), floatObjectOf(rcvr1 - arg1)); @@ -6742,14 +6691,14 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - goto l24; + goto l23; } } GIV(messageSelector) = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SpecialSelectors << ShiftForWord))) + BaseHeaderSize) + ((1 * 2) << ShiftForWord)); GIV(argumentCount) = 1; goto normalSend; } - l24: /* end case */; + l23: /* end case */; break; case 178: /* bytecodePrimLessThan */ @@ -6781,7 +6730,7 @@ else { goto booleanCheatFalse; } - goto l33; + goto l32; } /* begin initPrimCall */ GIV(primFailCode) = 0; @@ -6789,77 +6738,77 @@ /* begin loadFloatOrIntFrom: */ if ((rcvr & 1)) { rcvr1 = ((double) ((rcvr >> 1)) ); - goto l37; + goto l36; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((rcvr & 1)) { isFloat = 0; - goto l36; + goto l35; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((rcvr & 1))); ccIndex = (((usqInt) (longAt(rcvr))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex == 0) { isFloat = ((longAt(rcvr - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l40; + goto l39; } isFloat = ClassFloatCompactIndex == ccIndex; - goto l40; + goto l39; isFloat = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord))); - l40: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l36: /* end is:instanceOf:compactClassIndex: */; + l39: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l35: /* end is:instanceOf:compactClassIndex: */; if (isFloat) { ; fetchFloatAtinto(rcvr + BaseHeaderSize, result); rcvr1 = result; - goto l35; + goto l34; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } rcvr1 = 0.0; - l35: /* end floatValueOf: */; - l37: /* end loadFloatOrIntFrom: */; + l34: /* end floatValueOf: */; + l36: /* end loadFloatOrIntFrom: */; /* begin loadFloatOrIntFrom: */ if ((arg & 1)) { arg1 = ((double) ((arg >> 1)) ); - goto l41; + goto l40; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((arg & 1)) { isFloat1 = 0; - goto l39; + goto l38; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((arg & 1))); ccIndex1 = (((usqInt) (longAt(arg))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex1 == 0) { isFloat1 = ((longAt(arg - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l34; + goto l33; } isFloat1 = ClassFloatCompactIndex == ccIndex1; - goto l34; + goto l33; isFloat1 = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex1 - 1) << ShiftForWord))); - l34: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l39: /* end is:instanceOf:compactClassIndex: */; + l33: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l38: /* end is:instanceOf:compactClassIndex: */; if (isFloat1) { ; fetchFloatAtinto(arg + BaseHeaderSize, result1); arg1 = result1; - goto l38; + goto l37; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } arg1 = 0.0; - l38: /* end floatValueOf: */; - l41: /* end loadFloatOrIntFrom: */; + l37: /* end floatValueOf: */; + l40: /* end loadFloatOrIntFrom: */; aBool = rcvr1 < arg1; if (!GIV(primFailCode)) { /* begin booleanCheat: */ @@ -6869,13 +6818,13 @@ else { goto booleanCheatFalse; } - goto l33; + goto l32; } GIV(messageSelector) = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SpecialSelectors << ShiftForWord))) + BaseHeaderSize) + ((2 * 2) << ShiftForWord)); GIV(argumentCount) = 1; goto normalSend; } - l33: /* end case */; + l32: /* end case */; booleanCheatTrue: /* booleanCheatTrue */ @@ -6899,7 +6848,7 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - goto l312; + goto l310; } if (bytecode == 172) { @@ -6909,7 +6858,7 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - goto l312; + goto l310; } if (bytecode > 167) { @@ -6920,7 +6869,7 @@ localIP = (localIP + offset) + 1; currentBytecode = (byteAtPointer(localIP)) + GIV(bytecodeSetSelector); - goto l312; + goto l310; } } currentBytecode = bytecode + GIV(bytecodeSetSelector); @@ -6928,7 +6877,7 @@ /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), GIV(trueObj)); } - l312: /* end case */; + l310: /* end case */; break; case 179: /* bytecodePrimGreaterThan */ @@ -6960,7 +6909,7 @@ else { /* goto booleanCheatFalse */ } - goto l42; + goto l41; } /* begin initPrimCall */ GIV(primFailCode) = 0; @@ -6968,77 +6917,77 @@ /* begin loadFloatOrIntFrom: */ if ((rcvr & 1)) { rcvr1 = ((double) ((rcvr >> 1)) ); - goto l46; + goto l45; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((rcvr & 1)) { isFloat = 0; - goto l45; + goto l44; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((rcvr & 1))); ccIndex = (((usqInt) (longAt(rcvr))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex == 0) { isFloat = ((longAt(rcvr - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l49; + goto l48; } isFloat = ClassFloatCompactIndex == ccIndex; - goto l49; + goto l48; isFloat = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord))); - l49: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l45: /* end is:instanceOf:compactClassIndex: */; + l48: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l44: /* end is:instanceOf:compactClassIndex: */; if (isFloat) { ; fetchFloatAtinto(rcvr + BaseHeaderSize, result); rcvr1 = result; - goto l44; + goto l43; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } rcvr1 = 0.0; - l44: /* end floatValueOf: */; - l46: /* end loadFloatOrIntFrom: */; + l43: /* end floatValueOf: */; + l45: /* end loadFloatOrIntFrom: */; /* begin loadFloatOrIntFrom: */ if ((arg & 1)) { arg1 = ((double) ((arg >> 1)) ); - goto l50; + goto l49; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((arg & 1)) { isFloat1 = 0; - goto l48; + goto l47; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((arg & 1))); ccIndex1 = (((usqInt) (longAt(arg))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex1 == 0) { isFloat1 = ((longAt(arg - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l43; + goto l42; } isFloat1 = ClassFloatCompactIndex == ccIndex1; - goto l43; + goto l42; isFloat1 = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex1 - 1) << ShiftForWord))); - l43: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l48: /* end is:instanceOf:compactClassIndex: */; + l42: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l47: /* end is:instanceOf:compactClassIndex: */; if (isFloat1) { ; fetchFloatAtinto(arg + BaseHeaderSize, result1); arg1 = result1; - goto l47; + goto l46; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } arg1 = 0.0; - l47: /* end floatValueOf: */; - l50: /* end loadFloatOrIntFrom: */; + l46: /* end floatValueOf: */; + l49: /* end loadFloatOrIntFrom: */; aBool = rcvr1 > arg1; if (!GIV(primFailCode)) { /* begin booleanCheat: */ @@ -7048,13 +6997,13 @@ else { goto booleanCheatFalse; } - goto l42; + goto l41; } GIV(messageSelector) = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SpecialSelectors << ShiftForWord))) + BaseHeaderSize) + ((3 * 2) << ShiftForWord)); GIV(argumentCount) = 1; goto normalSend; } - l42: /* end case */; + l41: /* end case */; booleanCheatFalse: /* booleanCheatFalse */ @@ -7078,7 +7027,7 @@ localIP = (localIP + (bytecode - 151)) + 1; currentBytecode = (byteAtPointer(localIP)) + GIV(bytecodeSetSelector); - goto l313; + goto l311; } if (bytecode == 172) { @@ -7089,14 +7038,14 @@ localIP = (localIP + offset) + 1; currentBytecode = (byteAtPointer(localIP)) + GIV(bytecodeSetSelector); - goto l313; + goto l311; } currentBytecode = bytecode + GIV(bytecodeSetSelector); /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), GIV(falseObj)); } - l313: /* end case */; + l311: /* end case */; break; case 180: /* bytecodePrimLessOrEqual */ @@ -7128,7 +7077,7 @@ else { goto booleanCheatFalse; } - goto l51; + goto l50; } /* begin initPrimCall */ GIV(primFailCode) = 0; @@ -7136,77 +7085,77 @@ /* begin loadFloatOrIntFrom: */ if ((rcvr & 1)) { rcvr1 = ((double) ((rcvr >> 1)) ); - goto l55; + goto l54; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((rcvr & 1)) { isFloat = 0; - goto l54; + goto l53; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((rcvr & 1))); ccIndex = (((usqInt) (longAt(rcvr))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex == 0) { isFloat = ((longAt(rcvr - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l58; + goto l57; } isFloat = ClassFloatCompactIndex == ccIndex; - goto l58; + goto l57; isFloat = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord))); - l58: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l54: /* end is:instanceOf:compactClassIndex: */; + l57: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l53: /* end is:instanceOf:compactClassIndex: */; if (isFloat) { ; fetchFloatAtinto(rcvr + BaseHeaderSize, result); rcvr1 = result; - goto l53; + goto l52; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } rcvr1 = 0.0; - l53: /* end floatValueOf: */; - l55: /* end loadFloatOrIntFrom: */; + l52: /* end floatValueOf: */; + l54: /* end loadFloatOrIntFrom: */; /* begin loadFloatOrIntFrom: */ if ((arg & 1)) { arg1 = ((double) ((arg >> 1)) ); - goto l59; + goto l58; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((arg & 1)) { isFloat1 = 0; - goto l57; + goto l56; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((arg & 1))); ccIndex1 = (((usqInt) (longAt(arg))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex1 == 0) { isFloat1 = ((longAt(arg - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l52; + goto l51; } isFloat1 = ClassFloatCompactIndex == ccIndex1; - goto l52; + goto l51; isFloat1 = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex1 - 1) << ShiftForWord))); - l52: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l57: /* end is:instanceOf:compactClassIndex: */; + l51: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l56: /* end is:instanceOf:compactClassIndex: */; if (isFloat1) { ; fetchFloatAtinto(arg + BaseHeaderSize, result1); arg1 = result1; - goto l56; + goto l55; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } arg1 = 0.0; - l56: /* end floatValueOf: */; - l59: /* end loadFloatOrIntFrom: */; + l55: /* end floatValueOf: */; + l58: /* end loadFloatOrIntFrom: */; aBool = rcvr1 <= arg1; if (!GIV(primFailCode)) { /* begin booleanCheat: */ @@ -7216,13 +7165,13 @@ else { goto booleanCheatFalse; } - goto l51; + goto l50; } GIV(messageSelector) = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SpecialSelectors << ShiftForWord))) + BaseHeaderSize) + ((4 * 2) << ShiftForWord)); GIV(argumentCount) = 1; goto normalSend; } - l51: /* end case */; + l50: /* end case */; break; case 181: /* bytecodePrimGreaterOrEqual */ @@ -7254,7 +7203,7 @@ else { goto booleanCheatFalse; } - goto l60; + goto l59; } /* begin initPrimCall */ GIV(primFailCode) = 0; @@ -7262,77 +7211,77 @@ /* begin loadFloatOrIntFrom: */ if ((rcvr & 1)) { rcvr1 = ((double) ((rcvr >> 1)) ); - goto l64; + goto l63; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((rcvr & 1)) { isFloat = 0; - goto l63; + goto l62; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ assert(!((rcvr & 1))); ccIndex = (((usqInt) (longAt(rcvr))) >> (compactClassFieldLSB())) & 0x1F; if (ccIndex == 0) { isFloat = ((longAt(rcvr - BaseHeaderSize)) & AllButTypeMask) == (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))); - goto l67; + goto l66; } isFloat = ClassFloatCompactIndex == ccIndex; - goto l67; + goto l66; isFloat = (longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassFloat << ShiftForWord))) == (longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord))); - l67: /* end isClassOfNonImm:equalTo:compactClassIndex: */; - l63: /* end is:instanceOf:compactClassIndex: */; + l66: /* end isClassOfNonImm:equalTo:compactClassIndex: */; + l62: /* end is:instanceOf:compactClassIndex: */; if (isFloat) { ; fetchFloatAtinto(rcvr + BaseHeaderSize, result); rcvr1 = result; - goto l62; + goto l61; } /* begin primitiveFail */ if (!GIV(primFailCode)) { GIV(primFailCode) = 1; } rcvr1 = 0.0; - l62: /* end floatValueOf: */; - l64: /* end loadFloatOrIntFrom: */; + l61: /* end floatValueOf: */; + l63: /* end loadFloatOrIntFrom: */; /* begin loadFloatOrIntFrom: */ if ((arg & 1)) { arg1 = ((double) ((arg >> 1)) ); - goto l68; + goto l67; } /* begin floatValueOf: */ /* begin is:instanceOf:compactClassIndex: */ if ((arg & 1)) { isFloat1 = 0; - goto l66; + goto l65; } /* begin isClassOfNonImm:equalTo:compactClassIndex: */ @@ Diff output truncated at 50000 characters. @@

1 0

VM Maker: VMMaker.oscog-eem.914.mcz
by commits＠source.squeak.org 30 Oct '14

30 Oct '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.914.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.914 Author: eem Time: 29 October 2014, 4:46:56.613 pm UUID: bda96e1c-f22e-4b32-9ee1-620740e1fec5 Ancestors: VMMaker.oscog-eem.913 Spur: Implement safe access to contexts and methods when creating image segments (since internally married contexts and jitted methods have hidden state encoded in odd ways). As a result: Fix baaad bug in SpurMemoryManager>>lastPointerOf: for contexts, caused by transcription from (New)ObjectMemory where the method works on a wing and a prayer because BaseHeaderSize = BytesPerOop. And I can't be arsed to fix it. It's, cough, grody code. Refactor decoding of context instruction pointers so there is only one copy of the code. Fix baaad bug in accessibleObjectAfter: and add an assert to primitiveNextObject to catch similar bugs. Can now enumerate objects in new space, which will sort-of work, but code should really use allObjects. Will fix at the image level as time allows. Eliminate isInSurvivorSpace: in favour of the identical isInPastSpace:. All: Fix the comments in loadImageSegmentFrom:outPointers:; the array is not truncated to zero length; it retains its version info. Fix storeShort16:ofObject:withValue: to accept negative values. =============== Diff against VMMaker.oscog-eem.913 =============== Item was changed: ----- Method: CoInterpreter>>externalInstVar:ofContext: (in category 'frame access') ----- externalInstVar: offset ofContext: aContext "Fetch an instance variable from a maybe married context. If the context is still married compute the value of the relevant inst var from the spouse frame's state. If the context is single but has a negative instruction pointer recognise that the instruction pointer is actually into machine code and convert it to the corresponding bytecode pc." + | value | - | value spouseFP | - <var: #spouseFP type: #'char *'> - <var: #thePage type: #'StackPage *'> - <var: #theFPAbove type: #'char *'> self assert: (objectMemory isContext: aContext). - self externalWriteBackHeadFramePointers. "method, closureOrNil & receiver need no special handling; only sender, pc & stackp have to be computed for married contexts." + ((self isReadMediatedContextInstVarIndex: offset) - (offset < MethodIndex and: [self isMarriedOrWidowedContext: aContext]) ifFalse: [value := objectMemory fetchPointer: offset ofObject: aContext. ^(offset = InstructionPointerIndex and: [(objectMemory isIntegerObject: value) and: [value signedIntFromLong < 0]]) ifTrue: [self mustMapMachineCodePC: (objectMemory integerValueOf: value) context: aContext] ifFalse: [value]]. + self externalWriteBackHeadFramePointers. + ^(self isStillMarriedContext: aContext) + ifTrue: [self fetchPointer: offset ofMarriedContext: aContext] + ifFalse: [objectMemory fetchPointer: offset ofObject: aContext]! - (self isWidowedContext: aContext) ifTrue: - [^objectMemory fetchPointer: offset ofObject: aContext]. - - spouseFP := self frameOfMarriedContext: aContext. - offset = SenderIndex ifTrue: - [^self ensureCallerContext: spouseFP]. - offset = StackPointerIndex ifTrue: - [self assert: ReceiverIndex + (self stackPointerIndexForFrame: spouseFP) < (objectMemory lengthOf: aContext). - ^objectMemory integerObjectOf: (self stackPointerIndexForFrame: spouseFP)]. - offset = InstructionPointerIndex ifTrue: - [| theIP thePage theFPAbove | - spouseFP = framePointer - ifTrue: [theIP := self oopForPointer: instructionPointer] - ifFalse: - [thePage := stackPages stackPageFor: spouseFP. - theFPAbove := self findFrameAbove: spouseFP inPage: thePage. - theIP := theFPAbove == 0 - ifTrue: [stackPages longAt: thePage headSP] - ifFalse:[self oopForPointer: (self frameCallerSavedIP: theFPAbove)]]. - value := self contextInstructionPointer: theIP frame: spouseFP. - ^value signedIntFromLong < 0 - ifTrue: [self mustMapMachineCodePC: (objectMemory integerValueOf: value) - context: aContext] - ifFalse: [value]]. - self error: 'bad index'. - ^0! Item was changed: ----- Method: CoInterpreter>>instVar:ofContext: (in category 'frame access') ----- instVar: offset ofContext: aContext "Fetch an instance avriable from a maybe married context. If the context is still married compute the value of the relevant inst var from the spouse frame's state. If the context is single but has a negative instruction pointer recognise that the instruction pointer is actually into machine code and convert it to the corresponding bytecode pc." | value spouseFP | <var: #spouseFP type: #'char *'> - <var: #thePage type: #'StackPage *'> - <var: #theFPAbove type: #'char *'> <inline: true> self assert: offset < MethodIndex. self assert: (objectMemory isContext: aContext). self writeBackHeadFramePointers. (self isMarriedOrWidowedContext: aContext) ifFalse: [value := objectMemory fetchPointer: offset ofObject: aContext. (offset = InstructionPointerIndex + and: [(objectMemory isIntegerObject: value) - and: ["self halt: value hex." (objectMemory isIntegerObject: value) and: [value signedIntFromLong < 0]]) ifTrue: [value := self internalMustMapMachineCodePC: (objectMemory integerValueOf: value) context: aContext]. ^value]. (self isWidowedContext: aContext) ifTrue: [^objectMemory fetchPointer: offset ofObject: aContext]. spouseFP := self frameOfMarriedContext: aContext. offset = SenderIndex ifTrue: [^self ensureCallerContext: spouseFP]. offset = StackPointerIndex ifTrue: [self assert: ReceiverIndex + (self stackPointerIndexForFrame: spouseFP) < (objectMemory lengthOf: aContext). ^objectMemory integerObjectOf: (self stackPointerIndexForFrame: spouseFP)]. offset = InstructionPointerIndex ifTrue: + [^self instructionPointerForFrame: spouseFP currentFP: localFP currentIP: localIP]. - [| theIP thePage theFPAbove | - spouseFP = localFP - ifTrue: [theIP := self oopForPointer: localIP] - ifFalse: - [thePage := stackPages stackPageFor: spouseFP. - theFPAbove := self findFrameAbove: spouseFP inPage: thePage. - theIP := theFPAbove == 0 - ifTrue: [stackPages longAt: thePage headSP] - ifFalse:[self oopForPointer: (self frameCallerSavedIP: theFPAbove)]]. - value := self contextInstructionPointer: theIP frame: spouseFP. - value signedIntFromLong < 0 ifTrue: - [value := self internalMustMapMachineCodePC: (objectMemory integerValueOf: value) - context: aContext]. - ^value]. self error: 'bad index'. ^0! Item was added: + ----- Method: CoInterpreter>>instructionPointerForFrame:currentFP:currentIP: (in category 'frame access') ----- + instructionPointerForFrame: spouseFP currentFP: currentFP currentIP: instrPtr + "Answer the bytecode pc object (i.e. SmallInteger) for an active frame. The bytecode + pc is derived from the frame's pc. If the frame is the top frame on the current stack + the frame pc is whatever the current instruction pointer is. If the frame is the top + frame on some other stack the frame pc is the value on top of stack. Otherwise the + frame pc is the saved pc of the frame above. Once the frame pc is found it must be + mapped to a bytecode pc." + | value theIP thePage theFPAbove | + spouseFP = currentFP + ifTrue: [theIP := self oopForPointer: instrPtr] + ifFalse: + [thePage := stackPages stackPageFor: spouseFP. + theFPAbove := self findFrameAbove: spouseFP inPage: thePage. + theIP := theFPAbove == 0 + ifTrue: [stackPages longAt: thePage headSP] + ifFalse:[self oopForPointer: (self frameCallerSavedIP: theFPAbove)]]. + value := self contextInstructionPointer: theIP frame: spouseFP. + ^value signedIntFromLong < 0 + ifTrue: [self mustMapMachineCodePC: (objectMemory integerValueOf: value) + context: (self frameContext: spouseFP)] + ifFalse: [value]! Item was changed: ----- Method: CurrentImageCoInterpreterFacade>>isWriteMediatedContextInstVarIndex: (in category 'frame access') ----- isWriteMediatedContextInstVarIndex: index + "Writing any inst vars of a context must take account of potentially married contexts - "Wrining any inst vars of a context must take account of potentially married contexts and set the state in the frame. Inst vars in subclasses don't need mediation; subclasses can't marry." ^index <= ReceiverIndex! Item was changed: ----- Method: InterpreterPrimitives>>primitiveLoadImageSegment (in category 'image segment in/out') ----- primitiveLoadImageSegment "This primitive is called from Squeak as... <imageSegment> loadSegmentFrom: aWordArray outPointers: anArray." + "This primitive will load a binary image segment created by primitiveStoreImageSegment. + It expects the outPointer array to be of the proper size, and the wordArray to be well + formed. It will return as its value the original array of roots, and the erstwhile + segmentWordArray will have been truncated to a size of one word, i.e. retaining the version + stamp. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to + an unrecognizable and unusable jumble. But what more could you have done with it anyway?" - "This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of zero. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you have done with it anyway?" | outPointerArray segmentWordArray result | outPointerArray := self stackTop. segmentWordArray := self stackValue: 1. "Essential type checks" ((objectMemory isArray: outPointerArray) "Must be indexable pointers" and: [objectMemory isWords: segmentWordArray]) "Must be indexable words" ifFalse: [^self primitiveFail]. "the engine returns the roots array which was first in the segment, or an error code on failure." result := objectMemory loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray. (self oop: result isGreaterThan: segmentWordArray) ifTrue: [self pop: 3 thenPush: result] ifFalse: [self primitiveFailFor: result]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveNextObject (in category 'object access primitives') ----- primitiveNextObject "Return the object following the receiver in the heap. Return the SmallInteger zero when there are no more objects." + (objectMemory accessibleObjectAfter: self stackTop) + ifNil: [self pop: argumentCount+1 thenPushInteger: 0] + ifNotNil: [:instance| + self assert: (objectMemory isInMemory: instance). + self pop: argumentCount+1 thenPush: instance]! - | object instance | - object := self stackTop. - instance := objectMemory accessibleObjectAfter: object. - instance = nil - ifTrue: [ self pop: argumentCount+1 thenPushInteger: 0 ] - ifFalse: [ self pop: argumentCount+1 thenPush: instance ].! Item was changed: ----- Method: NewObjectMemory>>loadImageSegmentFrom:outPointers: (in category 'image segment in/out') ----- loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray "This primitive is called from Squeak as... <imageSegment> loadSegmentFrom: aWordArray outPointers: anArray." + "This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of one word, i.e. retaining the version stamp. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you have done with it anyway?" - "This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of zero. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you have done with it anyway?" | endSeg segOop fieldPtr fieldOop doingClass lastPtr extraSize mapOop lastOut outPtr hdrTypeBits header data | <inline: false> <var: #endSeg type: #usqInt> <var: #segOop type: #usqInt> <var: #fieldPtr type: #usqInt> <var: #lastOut type: #usqInt> <var: #outPtr type: #usqInt> <var: #lastPtr type: #usqInt> DoAssertionChecks ifTrue: [self verifyCleanHeaders]. lastOut := outPointerArray + (self lastPointerOf: outPointerArray). endSeg := segmentWordArray + (self sizeBitsOf: segmentWordArray) - BaseHeaderSize. "Version check. Byte order of the WordArray now" data := self longAt: segmentWordArray + BaseHeaderSize. (coInterpreter readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: "Not readable -- try again with reversed bytes..." [self reverseBytesFrom: segmentWordArray + BaseHeaderSize to: endSeg + BytesPerWord. data := self longAt: segmentWordArray + BaseHeaderSize. (coInterpreter readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: "Still NG -- put things back and fail" [self reverseBytesFrom: segmentWordArray + BaseHeaderSize to: endSeg + BytesPerWord. DoAssertionChecks ifTrue: [self verifyCleanHeaders]. ^PrimErrBadArgument]]. "Reverse the Byte type objects if the data is from opposite endian machine. Revese the words in Floats if from an earlier version with different Float order. Test top byte. $d on the Mac or $s on the PC. Rest of word is equal." (data >> 16) = (self imageSegmentVersion >> 16) ifTrue: "Need to swap floats if the segment is being loaded into a little-endian VM from a version that keeps Floats in big-endian word order as was the case prior to the 6505 image format." [(self isPlatformFloatOrderVersion: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: [self vmEndianness ~= 1 "~= 1 => little-endian" ifTrue: [segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord. self wordSwapFloatsFrom: segOop to: endSeg + BytesPerWord]]] ifFalse: "Reverse the byte-type objects once" [segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord. "Oop of first embedded object" self byteSwapByteObjectsFrom: segOop to: endSeg + BytesPerWord flipFloatsIf: (self isPlatformFloatOrderVersion: (data bitAnd: 16rFFFF "low 2 bytes"))]. "Proceed through the segment, remapping pointers..." segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord. [segOop <= endSeg] whileTrue: [(self headerType: segOop) <= 1 ifTrue: ["This object has a class field (type = 0 or 1) -- start with that." fieldPtr := segOop - BytesPerWord. doingClass := true] ifFalse: ["No class field -- start with first data field" fieldPtr := segOop + BaseHeaderSize. doingClass := false]. lastPtr := segOop + (self lastPointerOf: segOop). "last field" lastPtr > endSeg ifTrue: [DoAssertionChecks ifTrue: [self verifyCleanHeaders]. ^PrimErrBadIndex "out of bounds"]. "Go through all oops, remapping them..." [fieldPtr > lastPtr] whileFalse: ["Examine each pointer field" fieldOop := self longAt: fieldPtr. doingClass ifTrue: [hdrTypeBits := self headerType: fieldPtr. fieldOop := fieldOop - hdrTypeBits]. (self isIntegerObject: fieldOop) ifTrue: ["Integer -- nothing to do" fieldPtr := fieldPtr + BytesPerWord] ifFalse: [(fieldOop bitAnd: 3) = 0 ifFalse: [^PrimErrBadIndex "bad oop"]. (fieldOop bitAnd: 16r80000000) = 0 ifTrue: ["Internal pointer -- add segment offset" mapOop := fieldOop + segmentWordArray] ifFalse: ["External pointer -- look it up in outPointers" outPtr := outPointerArray + (fieldOop bitAnd: 16r7FFFFFFF). outPtr > lastOut ifTrue: [^PrimErrBadIndex "out of bounds"]. mapOop := self longAt: outPtr]. doingClass ifTrue: [self longAt: fieldPtr put: mapOop + hdrTypeBits. fieldPtr := fieldPtr + 8. doingClass := false] ifFalse: [self longAt: fieldPtr put: mapOop. fieldPtr := fieldPtr + BytesPerWord]. segOop < youngStart ifTrue: [self possibleRootStoreInto: segOop value: mapOop]]]. segOop := self objectAfter: segOop]. "Again, proceed through the segment checking consistency..." segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord. [segOop <= endSeg] whileTrue: [(self oopHasAcceptableClass: segOop) ifFalse: [^PrimErrInappropriate "inconsistency"]. fieldPtr := segOop + BaseHeaderSize. "first field" lastPtr := segOop + (self lastPointerOf: segOop). "last field" "Go through all oops, remapping them..." [fieldPtr > lastPtr] whileFalse: ["Examine each pointer field" fieldOop := self longAt: fieldPtr. (self oopHasAcceptableClass: fieldOop) ifFalse: [^PrimErrInappropriate "inconsistency"]. fieldPtr := fieldPtr + BytesPerWord]. segOop := self objectAfter: segOop]. "Truncate the segment word array to size = BytesPerWord (vers stamp only)" extraSize := self extraHeaderBytes: segmentWordArray. hdrTypeBits := self headerType: segmentWordArray. extraSize = 8 ifTrue: [self longAt: segmentWordArray-extraSize put: BaseHeaderSize + BytesPerWord + hdrTypeBits] ifFalse: [header := self longAt: segmentWordArray. self longAt: segmentWordArray put: header - (header bitAnd: SizeMask) + BaseHeaderSize + BytesPerWord]. "and return the roots array which was first in the segment" DoAssertionChecks ifTrue: [self verifyCleanHeaders]. ^self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord! Item was changed: ----- Method: ObjectMemory>>loadImageSegmentFrom:outPointers: (in category 'image segment in/out') ----- loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray "This primitive is called from Squeak as... <imageSegment> loadSegmentFrom: aWordArray outPointers: anArray." + "This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of one word, i.e. retaining the version stamp. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you have done with it anyway?" - "This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of zero. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you have done with it anyway?" | endSeg segOop fieldPtr fieldOop doingClass lastPtr extraSize mapOop lastOut outPtr hdrTypeBits header data | <inline: false> <var: #endSeg type: #usqInt> <var: #segOop type: #usqInt> <var: #fieldPtr type: #usqInt> <var: #lastOut type: #usqInt> <var: #outPtr type: #usqInt> <var: #lastPtr type: #usqInt> DoAssertionChecks ifTrue: [self verifyCleanHeaders]. lastOut := outPointerArray + (self lastPointerOf: outPointerArray). endSeg := segmentWordArray + (self sizeBitsOf: segmentWordArray) - BaseHeaderSize. "Version check. Byte order of the WordArray now" data := self longAt: segmentWordArray + BaseHeaderSize. (self readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: "Not readable -- try again with reversed bytes..." [self reverseBytesFrom: segmentWordArray + BaseHeaderSize to: endSeg + BytesPerWord. data := self longAt: segmentWordArray + BaseHeaderSize. (self readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: "Still NG -- put things back and fail" [self reverseBytesFrom: segmentWordArray + BaseHeaderSize to: endSeg + BytesPerWord. DoAssertionChecks ifTrue: [self verifyCleanHeaders]. ^PrimErrBadArgument]]. "Reverse the Byte type objects if the data is from opposite endian machine. Test top byte. $d on the Mac or $s on the PC. Rest of word is equal." (data >> 16) = (self imageSegmentVersion >> 16) ifFalse: "Reverse the byte-type objects once" [segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord. "Oop of first embedded object" self byteSwapByteObjectsFrom: segOop to: endSeg + BytesPerWord flipFloatsIf: false]. "Proceed through the segment, remapping pointers..." segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord. [segOop <= endSeg] whileTrue: [(self headerType: segOop) <= 1 ifTrue: ["This object has a class field (type = 0 or 1) -- start with that." fieldPtr := segOop - BytesPerWord. doingClass := true] ifFalse: ["No class field -- start with first data field" fieldPtr := segOop + BaseHeaderSize. doingClass := false]. lastPtr := segOop + (self lastPointerOf: segOop). "last field" lastPtr > endSeg ifTrue: [DoAssertionChecks ifTrue: [self verifyCleanHeaders]. ^PrimErrBadIndex "out of bounds"]. "Go through all oops, remapping them..." [fieldPtr > lastPtr] whileFalse: ["Examine each pointer field" fieldOop := self longAt: fieldPtr. doingClass ifTrue: [hdrTypeBits := self headerType: fieldPtr. fieldOop := fieldOop - hdrTypeBits]. (self isIntegerObject: fieldOop) ifTrue: ["Integer -- nothing to do" fieldPtr := fieldPtr + BytesPerWord] ifFalse: [(fieldOop bitAnd: 3) = 0 ifFalse: [^PrimErrBadIndex "bad oop"]. (fieldOop bitAnd: 16r80000000) = 0 ifTrue: ["Internal pointer -- add segment offset" mapOop := fieldOop + segmentWordArray] ifFalse: ["External pointer -- look it up in outPointers" outPtr := outPointerArray + (fieldOop bitAnd: 16r7FFFFFFF). outPtr > lastOut ifTrue: [^PrimErrBadIndex "out of bounds"]. mapOop := self longAt: outPtr]. doingClass ifTrue: [self longAt: fieldPtr put: mapOop + hdrTypeBits. fieldPtr := fieldPtr + 8. doingClass := false] ifFalse: [self longAt: fieldPtr put: mapOop. fieldPtr := fieldPtr + BytesPerWord]. segOop < youngStart ifTrue: [self possibleRootStoreInto: segOop value: mapOop]]]. segOop := self objectAfter: segOop]. "Again, proceed through the segment checking consistency..." segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord. [segOop <= endSeg] whileTrue: [(self oopHasAcceptableClass: segOop) ifFalse: [^PrimErrInappropriate "inconsistency"]. fieldPtr := segOop + BaseHeaderSize. "first field" lastPtr := segOop + (self lastPointerOf: segOop). "last field" "Go through all oops, remapping them..." [fieldPtr > lastPtr] whileFalse: ["Examine each pointer field" fieldOop := self longAt: fieldPtr. (self oopHasAcceptableClass: fieldOop) ifFalse: [^PrimErrInappropriate "inconsistency"]. fieldPtr := fieldPtr + BytesPerWord]. segOop := self objectAfter: segOop]. "Truncate the segment word array to size = BytesPerWord (vers stamp only)" extraSize := self extraHeaderBytes: segmentWordArray. hdrTypeBits := self headerType: segmentWordArray. extraSize = 8 ifTrue: [self longAt: segmentWordArray-extraSize put: BaseHeaderSize + BytesPerWord + hdrTypeBits] ifFalse: [header := self longAt: segmentWordArray. self longAt: segmentWordArray put: header - (header bitAnd: SizeMask) + BaseHeaderSize + BytesPerWord]. "and return the roots array which was first in the segment" DoAssertionChecks ifTrue: [self verifyCleanHeaders]. ^self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord! Item was changed: ----- Method: ObjectMemory>>storeShort16:ofObject:withValue: (in category 'object access') ----- + storeShort16: shortIndex ofObject: objOop withValue: value + ^self + shortAt: objOop + BaseHeaderSize + (shortIndex << 1) + put: (self cCode: [value] inSmalltalk: [value bitAnd: 16rFFFF])! - storeShort16: shortIndex ofObject: oop withValue: value - ^self shortAt: oop + BaseHeaderSize + (shortIndex << 1) put: value! Item was removed: - ----- Method: Spur32BitCoMemoryManager>>copyObj:toSegment:addr:stopAt:saveOopAt: (in category 'image segment in/out') ----- - copyObj: objOop toSegment: segmentWordArray addr: limitSeg stopAt: stopAddr saveOopAt: oopPtr - "Copy objOop into the segment beginning at limitSeg, and forward it to the copy. - Fail if out of space. Answer the next segmentAddr if successful." - - "Copy the object..." - | bodySize copy | - <inline: false> - bodySize := self bytesInObject: objOop. - (self oop: limitSeg + bodySize isGreaterThanOrEqualTo: stopAddr) ifTrue: - [^0]. "failure" - self mem: limitSeg asVoidPointer cp: (self startOfObject: objOop) asVoidPointer y: bodySize. - copy := self objectStartingAt: limitSeg. - - "Clear remebered pinned and mark bits of all headers copied into the segment" - self - setIsRememberedOf: copy to: false; - setIsPinnedOf: copy to: false; - setIsMarkedOf: copy to: false. - - "Make sure Cogged methods have their true header field written to the segment." - ((self isCompiledMethod: objOop) - and: [coInterpreter methodHasCogMethod: objOop]) ifTrue: - [self storePointerUnchecked: HeaderIndex - ofObject: copy - withValue: (self methodHeaderOf: objOop)]. - - "Remember the oop for undoing in case of prim failure." - self longAt: oopPtr put: objOop. - self forward: objOop to: copy. - - "Return new end of segment" - ^limitSeg + bodySize! Item was added: + ----- Method: Spur32BitCoMemoryManager>>ifAProxy:updateCopy: (in category 'image segment in/out') ----- + ifAProxy: objOop updateCopy: copy + "If the obejct being copied to the segment is weird and has exotic state, + i.e. a married context or a jitted method, update the copy with the vanilla state." + + super ifAProxy: objOop updateCopy: copy. + (self isCompiledMethod: objOop) ifTrue: + [| methodHeader | + methodHeader := coInterpreter rawHeaderOf: objOop. + (coInterpreter isCogMethodReference: methodHeader) ifTrue: + [self storePointerUnchecked: HeaderIndex + ofObject: copy + withValue: (coInterpreter cCoerceSimple: methodHeader to: #'CogMethod *') methodHeader]]! Item was changed: ----- Method: Spur32BitMMLESimulator>>setIsMarkedOf:to: (in category 'header access') ----- setIsMarkedOf: objOop to: aBoolean "objOop = 16rB26020 ifTrue: [self halt]." + "(#(16r1971D0 16r196EE0 16r197048 16r197148) includes: objOop) ifTrue: + [self halt]." super setIsMarkedOf: objOop to: aBoolean. "(aBoolean and: [(self isContextNonImm: objOop) and: [(coInterpreter checkIsStillMarriedContext: objOop currentFP: coInterpreter framePointer) and: [(coInterpreter stackPages stackPageFor: (coInterpreter frameOfMarriedContext: objOop)) trace = 0]]]) ifTrue: [self halt]"! Item was changed: ----- Method: SpurMemoryManager>>accessibleObjectAfter: (in category 'object enumeration') ----- accessibleObjectAfter: objOop "Answer the accessible object following the given object or free chunk in the heap. Return nil when heap is exhausted. + This is for primitiveNextObject subsequent to primtiiveSomeObject. + It also tries to handle more general use by ordering objects as + eden + past + old + but this is tricky becaus ethe order in memory is + past + eden + old" - This is for primitiveNextObject subsequent to primtiiveSomeObject." <inline: false> | objAfter | objAfter := objOop. + (self oop: objAfter isLessThan: nilObj) ifTrue: "object in new space" + [self assert: ((self isInEden: objOop) or: [self isInPastSpace: objOop]). + (self oop: objAfter isGreaterThan: pastSpaceStart) ifTrue: + ["Obj is in eden. Answer next normal object in eden, if there is one." + [objAfter := self objectAfter: objAfter limit: freeStart. + self oop: objAfter isLessThan: freeStart] whileTrue: + [(self isNormalObject: objAfter) ifTrue: + [^objAfter]]. + "There wasn't a next object in eden. If past space is empty answer nilObj." + pastSpaceStart <= scavenger pastSpace start ifTrue: + [^nilObj]. + "If the first object in pastSpace is OK, answer it, otherwise fall through to enumerate past space." + objAfter := self objectStartingAt: scavenger pastSpace start. + (self isNormalObject: objAfter) ifTrue: + [^objAfter]]. + "Either objOop was in pastSpace, or enumeration exhaused eden, so enumerate past space." + [objAfter := self objectAfter: objAfter limit: pastSpaceStart. + self oop: objAfter isLessThan: pastSpaceStart] whileTrue: + [(self isNormalObject: objAfter) ifTrue: + [^objAfter]]. + ^nilObj]. [objAfter := self objectAfter: objAfter limit: endOfMemory. objAfter = endOfMemory ifTrue: [^nil]. (self isNormalObject: objAfter) ifTrue: [^objAfter]] repeat! Item was changed: ----- Method: SpurMemoryManager>>addressCouldBeObj: (in category 'debug support') ----- addressCouldBeObj: address <api> <inline: false> ^(address bitAnd: self baseHeaderSize - 1) = 0 and: [(self isInOldSpace: address) or: [(self isInEden: address) + or: [(self isInPastSpace: address) - or: [(self isInSurvivorSpace: address) or: [scavengeInProgress and: [self isInFutureSpace: address]]]]]! Item was changed: ----- Method: SpurMemoryManager>>copyObj:toAddr:startAt:stopAt: (in category 'image segment in/out') ----- copyObj: objOop toAddr: segAddr startAt: segStart stopAt: endSeg "Copy objOop into the segment beginning at segAddr, and forward it to the copy. If it is a class in the class table, set the copy's hash to 0 for reassignment on load, and mark it as a class by setting its isRemembered bit. Answer the next segmentAddr if successful. Answer an appropriate error code if not" "Copy the object..." | bodySize copy hash newOop | <inline: false> bodySize := self bytesInObject: objOop. (self oop: segAddr + bodySize isGreaterThanOrEqualTo: endSeg) ifTrue: [^PrimErrWritePastObject]. self mem: segAddr asVoidPointer cp: (self startOfObject: objOop) asVoidPointer y: bodySize. copy := self objectStartingAt: segAddr. "Clear remembered, mark bits of all headers copied into the segment (except classes)" self setIsRememberedOf: copy to: false; setIsMarkedOf: copy to: false. + + self ifAProxy: objOop updateCopy: copy. + "If the object is a class, zero its identityHash (which is its classIndex) and set its isRemembered bit. It will be assigned a new hash and entered into the table on load." hash := self rawHashBitsOf: objOop. (hash > self lastClassIndexPun and: [(self classOrNilAtIndex: hash) = objOop]) ifTrue: [self setHashBitsOf: copy to: 0. self setIsRememberedOf: copy to: true]. newOop := copy - segStart / self allocationUnit. newOop > self maxIdentityHash ifTrue: [^PrimErrLimitExceeded]. self setHashBitsOf: objOop to: copy - segStart / self allocationUnit. self setIsMarkedOf: objOop to: true. "Answer the new end of segment" ^segAddr + bodySize! Item was added: + ----- Method: SpurMemoryManager>>ifAProxy:updateCopy: (in category 'image segment in/out') ----- + ifAProxy: objOop updateCopy: copy + "If the obejct being copied to the segment is weird and has exotic state, + i.e. a married context or a jitted method, update the copy with the vanilla state." + + ((self isContext: objOop) + and: [coInterpreter isMarriedOrWidowedContext: objOop]) ifTrue: + [| numMediatedSlots | + "Since the context is here via objectsReachableFromRoots: we know it cannot be divorced. + I'd like to assert coInterpreter checkIsStillMarriedContext: objOop currentFP: framePointer, + here but that requires access to framePointer." + numMediatedSlots := coInterpreter numSlotsOfMarriedContext: objOop. + 0 to: numMediatedSlots - 1 do: + [:i| | oop | + oop := coInterpreter fetchPointer: i ofMarriedContext: objOop. + self storePointerUnchecked: i ofObject: copy withValue: oop]. + "And make sure to nil the slots beyond the top of stack..." + numMediatedSlots to: (self numSlotsOf: objOop) - 1 do: + [:i| + self storePointerUnchecked: i ofObject: copy withValue: nilObj]]! Item was changed: ----- Method: SpurMemoryManager>>instanceAfter: (in category 'object enumeration') ----- instanceAfter: objOop | actualObj classIndex | actualObj := objOop. classIndex := self classIndexOf: objOop. (self isInEden: objOop) ifTrue: [[actualObj := self objectAfter: actualObj limit: freeStart. self oop: actualObj isLessThan: freeStart] whileTrue: [classIndex = (self classIndexOf: actualObj) ifTrue: [^actualObj]]. actualObj := (self oop: pastSpaceStart isGreaterThan: scavenger pastSpace start) ifTrue: [self objectStartingAt: scavenger pastSpace start] ifFalse: [nilObj]]. + (self isInPastSpace: actualObj) ifTrue: - (self isInSurvivorSpace: actualObj) ifTrue: [[actualObj := self objectAfter: actualObj limit: pastSpaceStart. self oop: actualObj isLessThan: pastSpaceStart] whileTrue: [classIndex = (self classIndexOf: actualObj) ifTrue: [^actualObj]]. actualObj := nilObj]. [actualObj := self objectAfter: actualObj limit: endOfMemory. self oop:actualObj isLessThan: endOfMemory] whileTrue: [classIndex = (self classIndexOf: actualObj) ifTrue: [^actualObj]]. ^nil! Item was changed: ----- Method: SpurMemoryManager>>isInMemory: (in category 'plugin support') ----- isInMemory: address "Answer if the given address is in ST object memory." + (self isInNewSpace: address) ifTrue: + [^(self isInEden: address) + or: [(self isInPastSpace: address) + or: [scavengeInProgress and: [self isInFutureSpace: address]]]]. + ^segmentManager isInSegments: address! - ^(self isInNewSpace: address) - or: [segmentManager isInSegments: address]! Item was removed: - ----- Method: SpurMemoryManager>>isInSurvivorSpace: (in category 'object testing') ----- - isInSurvivorSpace: address - ^self - oop: address - isGreaterThanOrEqualTo: scavenger pastSpace start - andLessThan: pastSpaceStart! Item was changed: ----- Method: SpurMemoryManager>>lastPointerOf: (in category 'object enumeration') ----- lastPointerOf: objOop "Answer the byte offset of the last pointer field of the given object. Works with CompiledMethods, as well as ordinary objects." <api> <inline: true> <asmLabel: false> | fmt contextSize header | fmt := self formatOf: objOop. self assert: fmt ~= self forwardedFormat. fmt <= self lastPointerFormat ifTrue: [(fmt = self indexablePointersFormat and: [self isContextNonImm: objOop]) ifTrue: ["contexts end at the stack pointer" contextSize := coInterpreter fetchStackPointerOf: objOop. + ^CtxtTempFrameStart - 1 + contextSize * BytesPerOop + self baseHeaderSize]. - ^CtxtTempFrameStart + contextSize * BytesPerOop]. ^(self numSlotsOf: objOop) - 1 * BytesPerOop + self baseHeaderSize "all pointers"]. fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers" "CompiledMethod: contains both pointers and bytes" header := self methodHeaderOf: objOop. ^self lastPointerOfMethodHeader: header! Item was changed: ----- Method: SpurMemoryManager>>loadImageSegmentFrom:outPointers: (in category 'image segment in/out') ----- loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray "This primitive is called from Squeak as... <imageSegment> loadSegmentFrom: aWordArray outPointers: anArray." "This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will + have been truncated to a size of one word, i.e. retaining the version stamp. If this primitive + should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and + unusable jumble. But what more could you have done with it anyway?" - have been truncated to a size of zero. If this primitive should fail, the segmentWordArray will, - sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you - have done with it anyway?" <inline: false> | segmentLimit segmentStart segVersion errorCode | + + segmentLimit := self numSlotsOf: segmentWordArray. + (self objectBytesForSlots: segmentLimit) < (self allocationUnit "version info" + self baseHeaderSize "one object header") ifTrue: + [^PrimErrBadArgument]. + "First thing is to verify format. If Spur is ever ported to big-endian machines then the segment may have to be byte/word swapped, but so far it only runs on little-endian machines, so for now just fail if endinanness is wrong." - segVersion := self longAt: segmentWordArray + self baseHeaderSize. (coInterpreter readableFormat: (segVersion bitAnd: 16rFFFF "low 2 bytes")) ifFalse: [self reverseBytesFrom: segmentWordArray + self baseHeaderSize to: (self addressAfter: segmentWordArray). segVersion := self longAt: segmentWordArray + self baseHeaderSize. (coInterpreter readableFormat: (segVersion bitAnd: 16rFFFF "low 2 bytes")) ifFalse: [self reverseBytesFrom: segmentWordArray + self baseHeaderSize to: (self addressAfter: segmentWordArray). ^PrimErrBadArgument]]. segmentStart := segmentWordArray + self baseHeaderSize + self allocationUnit. + segmentLimit := segmentLimit * self bytesPerOop + segmentWordArray + self baseHeaderSize. - segmentLimit := (self numSlotsOf: segmentWordArray) * self bytesPerOop + segmentWordArray + self baseHeaderSize. "Notionally reverse the Byte type objects if the data is from opposite endian machine. Test top byte. $d on the Mac or $s on the PC. Rest of word is equal. If Spur is ever ported to big-endian machines then the segment may have to be byte/word swapped, but so far it only runs on little-endian machines, so for now just fail if endinanness is wrong." self flag: #endianness. (segVersion >> 16) ~= (self imageSegmentVersion >> 16) ifTrue: "Reverse the byte-type objects once" [true ifTrue: [^PrimErrBadArgument] ifFalse: [self byteSwapByteObjectsFrom: (self objectStartingAt: segmentStart) to: segmentLimit flipFloatsIf: false]]. "scan through mapping oops and validating class references. Defer entering any class objects into the class table and/or pinning objects until a second pass." errorCode := self mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray. errorCode ~= 0 ifTrue: [^errorCode]. "Scan for classes contained in the segment, entering them into the class table. Classes are at the front, after the root array and have the remembered bit set." errorCode := self enterClassesIntoClassTableFrom: segmentStart to: segmentLimit. errorCode ~= 0 ifTrue: [^errorCode]. "Make a final pass, assigning class indices and/or pinning pinned objects" self assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray. "Finally evaporate the container, leaving the newly loaded objects in place." (self hasOverflowHeader: segmentWordArray) + ifTrue: [self setOverflowNumSlotsOf: segmentWordArray to: self allocationUnit / self bytesPerSlot] + ifFalse: [self setRawNumSlotsOf: segmentWordArray to: self allocationUnit / self bytesPerSlot]. - ifTrue: [self setOverflowNumSlotsOf: segmentWordArray to: 0] - ifFalse: [self setRawNumSlotsOf: segmentWordArray to: 0]. self leakCheckImageSegments ifTrue: [self runLeakCheckerForFullGC: true]. ^self objectStartingAt: segmentStart! Item was changed: ----- Method: SpurMemoryManager>>objectAfter: (in category 'object enumeration') ----- objectAfter: objOop <api> "Object parsing. 1. all objects have at least a word following the header, for a forwarding pointer. 2. objects with an overflow size have a preceeing word with a saturated slotSize. If the word following an object doesn't have a saturated size field it must be a single-header object. If the word following does have a saturated slotSize it must be the overflow size word." <inline: false> (self oop: objOop isLessThan: newSpaceLimit) ifTrue: [(self isInEden: objOop) ifTrue: [^self objectAfter: objOop limit: freeStart]. + (self isInPastSpace: objOop) ifTrue: - (self isInSurvivorSpace: objOop) ifTrue: [^self objectAfter: objOop limit: pastSpaceStart]. ^self objectAfter: objOop limit: scavenger futureSurvivorStart]. ^self objectAfter: objOop limit: endOfMemory! Item was changed: ----- Method: SpurMemoryManager>>objectsReachableFromRoots: (in category 'image segment in/out') ----- objectsReachableFromRoots: arrayOfRoots "Answer an Array of all the objects only reachable from the argument, an Array of root objects, starting with arrayOfRoots. If there is no space, answer a SmallInteger whose value is the number of slots required. This is used to collect the objects to include in an image segment on Spur, separate from creating the segment, hence simplifying the implementation. Thanks to Igor Stasenko for this idea." | freeChunk ptr start limit count oop objOop | self assert: (self isArray: arrayOfRoots). "Mark all objects except those only reachable from the arrayOfRoots by marking each object in arrayOfRoots and then marking all reachable objects (from the system roots). This leaves unmarked only objects reachable from the arrayOfRoots. N.B. A side-effect of the marking is that all forwarders in arrayOfRoots will be followed." self assert: self allObjectsUnmarked. self markObjectsIn: arrayOfRoots. self markObjects: false. "After the mark phase all unreachable weak slots will have been nilled and all active ephemerons fired." self assert: (self isEmptyObjStack: markStack). self assert: (self isEmptyObjStack: weaklingStack). self assert: self noUnscannedEphemerons. "Use the largest free chunk to answer the result." freeChunk := self allocateLargestFreeChunk. ptr := start := freeChunk + self baseHeaderSize. limit := self addressAfter: freeChunk. count := 0. "First put the arrayOfRoots; order is important." count := count + 1. ptr < limit ifTrue: [self longAt: ptr put: arrayOfRoots. ptr := ptr + self bytesPerSlot]. 0 to: (self numSlotsOf: arrayOfRoots) - 1 do: [:i| oop := self fetchPointer: i ofObject: arrayOfRoots. (self isNonImmediate: oop) ifTrue: [self push: oop onObjStack: markStack]]. "Now collect the unmarked objects reachable from the roots." [self isEmptyObjStack: markStack] whileFalse: [objOop := self popObjStack: markStack. count := count + 1. ptr < limit ifTrue: [self longAt: ptr put: objOop. ptr := ptr + self bytesPerSlot]. oop := self fetchClassOfNonImm: objOop. (self isMarked: oop) ifFalse: [self setIsMarkedOf: objOop to: true. self push: oop onObjStack: markStack]. + ((self isContextNonImm: objOop) + and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the loop" + ifTrue: + [0 to: (coInterpreter numSlotsOfMarriedContext: objOop) - 1 do: + [:i| + oop := coInterpreter fetchPointer: i ofMarriedContext: objOop. + ((self isImmediate: oop) + or: [self isMarked: oop]) ifFalse: + [self setIsMarkedOf: objOop to: true. + self push: oop onObjStack: markStack]]] + ifFalse: + [0 to: (self numPointerSlotsOf: objOop) - 1 do: + [:i| + oop := self fetchPointer: i ofObject: objOop. + ((self isImmediate: oop) + or: [self isMarked: oop]) ifFalse: + [self setIsMarkedOf: objOop to: true. + self push: oop onObjStack: markStack]]]]. - 0 to: (self numPointerSlotsOf: objOop) - 1 do: - [:i| - oop := self fetchPointer: i ofObject: objOop. - ((self isImmediate: oop) - or: [self isMarked: oop]) ifFalse: - [self setIsMarkedOf: objOop to: true. - self push: oop onObjStack: markStack]]]. self unmarkAllObjects. totalFreeOldSpace := totalFreeOldSpace - (self bytesInObject: freeChunk). "Now try and allocate the result" (count > (ptr - start / self bytesPerSlot) "not enough room" or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word" [self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk). self checkFreeSpace. ^self integerObjectOf: count]. "There's room; set the format, & classIndex and shorten." self setFormatOf: freeChunk to: self arrayFormat. self setClassIndexOf: freeChunk to: ClassArrayCompactIndex. self shorten: freeChunk toIndexableSize: count. self possibleRootStoreInto: freeChunk. self checkFreeSpace. self runLeakCheckerForFullGC: false. ^freeChunk! Item was changed: ----- Method: SpurMemoryManager>>storeShort16:ofObject:withValue: (in category 'object access') ----- storeShort16: shortIndex ofObject: objOop withValue: value + ^self + shortAt: objOop + self baseHeaderSize + (shortIndex << 1) + put: (self cCode: [value] inSmalltalk: [value bitAnd: 16rFFFF])! - ^self shortAt: objOop + self baseHeaderSize + (shortIndex << 1) put: value! Item was changed: ----- Method: StackInterpreter>>externalInstVar:ofContext: (in category 'frame access') ----- externalInstVar: offset ofContext: aContext "Fetch an instance variable from a maybe married context. If the context is still married compute the value of the relevant inst var from the spouse frame's state." - | spouseFP | - <var: #spouseFP type: #'char *'> - <var: #thePage type: #'StackPage *'> - <var: #theFPAbove type: #'char *'> - self assert: (objectMemory isContext: aContext). "method, closureOrNil & receiver need no special handling; only sender, pc & stackp have to be computed for married contexts." + ((self isReadMediatedContextInstVarIndex: offset) - (offset < MethodIndex and: [self isMarriedOrWidowedContext: aContext]) ifFalse: [^objectMemory fetchPointer: offset ofObject: aContext]. self externalWriteBackHeadFramePointers. + ^(self isStillMarriedContext: aContext) + ifTrue: [self fetchPointer: offset ofMarriedContext: aContext] + ifFalse: [objectMemory fetchPointer: offset ofObject: aContext]! - (self isWidowedContext: aContext) ifTrue: - [^objectMemory fetchPointer: offset ofObject: aContext]. - - spouseFP := self frameOfMarriedContext: aContext. - offset = SenderIndex ifTrue: - [^self ensureCallerContext: spouseFP]. - offset = StackPointerIndex ifTrue: - [self assert: ReceiverIndex + (self stackPointerIndexForFrame: spouseFP) < (objectMemory lengthOf: aContext). - ^objectMemory integerObjectOf: (self stackPointerIndexForFrame: spouseFP)]. - offset = InstructionPointerIndex ifTrue: - [| theIP thePage theFPAbove | - spouseFP = framePointer - ifTrue: [theIP := self oopForPointer: instructionPointer] - ifFalse: - [thePage := stackPages stackPageFor: spouseFP. - theFPAbove := self findFrameAbove: spouseFP inPage: thePage. - theIP := theFPAbove == 0 - ifTrue: [stackPages longAt: thePage headSP] - ifFalse:[self oopForPointer: (self frameCallerSavedIP: theFPAbove)]]. - ^self contextInstructionPointer: theIP frame: spouseFP]. - self error: 'bad index'. - ^0! Item was added: + ----- Method: StackInterpreter>>fetchPointer:ofMarriedContext: (in category 'frame access') ----- + fetchPointer: offset ofMarriedContext: aContext + "Fetch a slot from a married context. Compute the value + of the relevant inst var from the spouse frame's state. + + This method assumes frame pointers have been written back." + | spouseFP | + <inline: false> + <var: #spouseFP type: #'char *'> + + self assert: (objectMemory isContext: aContext). + self assert: (stackPage headFP = framePointer and: [stackPage headSP = stackPointer]). + self assert: (self checkIsStillMarriedContext: aContext currentFP: framePointer). + + "method, closureOrNil & receiver need no special handling; only + sender, pc & stackp have to be computed for married contexts." + offset <= ReceiverIndex ifTrue: + [(self isReadMediatedContextInstVarIndex: offset) ifFalse: + [^objectMemory fetchPointer: offset ofObject: aContext]. + + spouseFP := self frameOfMarriedContext: aContext. + offset = SenderIndex ifTrue: + [^self ensureCallerContext: spouseFP]. + offset = StackPointerIndex ifTrue: + [^objectMemory integerObjectOf: (self stackPointerIndexForFrame: spouseFP)]. + offset = InstructionPointerIndex ifTrue: + [^self instructionPointerForFrame: spouseFP currentFP: framePointer currentIP: instructionPointer]]. + + spouseFP := self frameOfMarriedContext: aContext. + ^(offset - ReceiverIndex between: 1 and: (self stackPointerIndexForFrame: spouseFP)) + ifTrue: [self temporary: offset - (ReceiverIndex + 1) in: spouseFP] + ifFalse: [objectMemory nilObject]! Item was changed: ----- Method: StackInterpreter>>instVar:ofContext: (in category 'frame access') ----- instVar: offset ofContext: aContext "Fetch an instance variable from a maybe married context. If the context is still married compute the value of the relevant inst var from the spouse frame's state." | spouseFP | <var: #spouseFP type: #'char *'> - <var: #thePage type: #'StackPage *'> - <var: #theFPAbove type: #'char *'> <inline: true> self assert: offset < MethodIndex. self assert: (objectMemory isContext: aContext). (self isMarriedOrWidowedContext: aContext) ifFalse: [^objectMemory fetchPointer: offset ofObject: aContext]. self writeBackHeadFramePointers. (self isWidowedContext: aContext) ifTrue: [^objectMemory fetchPointer: offset ofObject: aContext]. spouseFP := self frameOfMarriedContext: aContext. offset = SenderIndex ifTrue: [^self ensureCallerContext: spouseFP]. offset = StackPointerIndex ifTrue: [self assert: ReceiverIndex + (self stackPointerIndexForFrame: spouseFP) < (objectMemory lengthOf: aContext). ^objectMemory integerObjectOf: (self stackPointerIndexForFrame: spouseFP)]. offset = InstructionPointerIndex ifTrue: + [^self instructionPointerForFrame: spouseFP currentFP: localFP currentIP: localIP]. - [| theIP thePage theFPAbove | - spouseFP = localFP - ifTrue: [theIP := self oopForPointer: localIP] - ifFalse: - [thePage := stackPages stackPageFor: spouseFP. - theFPAbove := self findFrameAbove: spouseFP inPage: thePage. - theIP := theFPAbove == 0 - ifTrue: [stackPages longAt: thePage headSP] - ifFalse:[self oopForPointer: (self frameCallerSavedIP: theFPAbove)]]. - ^self contextInstructionPointer: theIP frame: spouseFP]. self error: 'bad index'. ^0! Item was changed: ----- Method: StackInterpreter>>instVar:ofContext:put: (in category 'frame access') ----- instVar: index ofContext: aMarriedContext put: anOop | theFP | "Assign the field of a married context. The important case to optimize is + assigning the sender. We could also consider optimizing assigning the IP but - assigning the sender. We could also consider optimizing assiging the IP but typically that is followed by an assignment to the stack pointer and we can't efficiently assign the stack pointer because it involves moving frames around." <inline: true> self assert: (self isMarriedOrWidowedContext: aMarriedContext). self writeBackHeadFramePointers. (self isStillMarriedContext: aMarriedContext) ifFalse: [objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop. index = StackPointerIndex ifTrue: [self ensureContextIsExecutionSafeAfterAssignToStackPointer: aMarriedContext]. ^nil]. theFP := self frameOfMarriedContext: aMarriedContext. index == SenderIndex ifTrue: [| thePage onCurrentPage | thePage := stackPages stackPageFor: theFP. self assert: stackPage = stackPages mostRecentlyUsedPage. onCurrentPage := thePage = stackPage. self storeSenderOfFrame: theFP withValue: anOop. onCurrentPage ifTrue: [localFP := stackPage headFP. localSP := stackPage headSP] ifFalse: [stackPages markStackPageMostRecentlyUsed: stackPage]. ^nil]. self externalizeIPandSP. self externalDivorceFrame: theFP andContext: aMarriedContext. objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop. index = StackPointerIndex ifTrue: [self ensureContextIsExecutionSafeAfterAssignToStackPointer: aMarriedContext]. self internalizeIPandSP. "Assigning various fields can force a divorce which can change the stackPage." stackPages markStackPageMostRecentlyUsed: stackPage. self assertValidExecutionPointe: localIP asUnsignedInteger r: localFP s: localSP imbar: true line: #'__LINE__'! Item was added: + ----- Method: StackInterpreter>>instructionPointerForFrame:currentFP:currentIP: (in category 'frame access') ----- + instructionPointerForFrame: spouseFP currentFP: currentFP currentIP: instrPtr + "Answer the bytecode pc object (i.e. SmallInteger) for an active frame. The bytecode + pc is derived from the frame's pc. If the frame is the top frame on the current stack + the frame pc is whatever the current instruction pointer is. If the frame is the top + frame on some other stack the frame pc is the value on top of stack. Otherwise the + frame pc is the saved pc of the frame above. Once the frame pc is found it must be + mapped to a bytecode pc." + | theIP thePage theFPAbove | + spouseFP = currentFP + ifTrue: [theIP := self oopForPointer: instrPtr] + ifFalse: + [thePage := stackPages stackPageFor: spouseFP. + theFPAbove := self findFrameAbove: spouseFP inPage: thePage. + theIP := theFPAbove == 0 + ifTrue: [stackPages longAt: thePage headSP] + ifFalse:[self oopForPointer: (self frameCallerSavedIP: theFPAbove)]]. + ^self contextInstructionPointer: theIP frame: spouseFP! Item was changed: ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') ----- longPrintOop: oop <api> | fmt lastIndex startIP bytecodesPerLine column | ((objectMemory isImmediate: oop) or: [(objectMemory addressCouldBeObj: oop) not or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0 or: [(objectMemory isFreeObject: oop) or: [objectMemory isForwarded: oop]]]]) ifTrue: [self printOop: oop. ^self]. self printHex: oop. (objectMemory fetchClassOfNonImm: oop) ifNil: [self print: ' has a nil class!!!!'] ifNotNil: [:class| self print: ': a(n) '; printNameOfClass: class count: 5; print: ' ('. objectMemory hasSpurMemoryManagerAPI ifTrue: [self printHexnp: (objectMemory compactClassIndexOf: oop); print: '=>']. self printHexnp: class; print: ')']. fmt := objectMemory formatOf: oop. self print: ' format '; printHexnp: fmt. fmt > objectMemory lastPointerFormat ifTrue: [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)] ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue: [| len | len := objectMemory lengthOf: oop. self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]]. objectMemory printHeaderTypeOf: oop. self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop). self cr. (fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue: [^self printStringOf: oop; cr]. (fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue: [0 to: ((objectMemory num32BitUnitsOf: oop) min: 256) - 1 do: [:i| | fieldOop | fieldOop := objectMemory fetchLong32: i ofObject: oop. + self space; printNum: i; space; printHex: fieldOop; space; cr]. - self space; printNum: i - 1; space; printHex: fieldOop; space; cr]. ^self]. "this is nonsense. apologies." startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop. lastIndex := 256 min: startIP. lastIndex > 0 ifTrue: [1 to: lastIndex do: [:i| | fieldOop | fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop. self space; printNum: i - 1; space; printHex: fieldOop; space. (i = 1 and: [objectMemory isCompiledMethod: oop]) ifTrue: [self printMethodHeaderOop: fieldOop] ifFalse: [self cCode: [self printOopShort: fieldOop] inSmalltalk: [self print: (self shortPrint: fieldOop)]]. self cr]]. (objectMemory isCompiledMethod: oop) ifFalse: [startIP > 64 ifTrue: [self print: '...'; cr]] ifTrue: [startIP := startIP * BytesPerWord + 1. lastIndex := objectMemory lengthOf: oop. lastIndex - startIP > 100 ifTrue: [lastIndex := startIP + 100]. bytecodesPerLine := 8. column := 1. startIP to: lastIndex do: [:index| | byte | column = 1 ifTrue: [self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)' inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']]. byte := objectMemory fetchByte: index - 1 ofObject: oop. self cCode: 'printf(" %02x/%-3d", byte,byte)' inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte]. column := column + 1. column > bytecodesPerLine ifTrue: [column := 1. self cr]]. column = 1 ifFalse: [self cr]]! Item was added: + ----- Method: StackInterpreter>>numSlotsOfMarriedContext: (in category 'internal interpreter access') ----- + numSlotsOfMarriedContext: aContext + "Answer the number of effective pointer fields in the given context." + <inline: true> + | contextSize | + contextSize := self stackPointerIndexForFrame: (self frameOfMarriedContext: aContext). + ^CtxtTempFrameStart + contextSize! Item was changed: ----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') ----- utilitiesMenu: aMenuMorph aMenuMorph add: 'toggle transcript' action: #toggleTranscript; add: 'clone VM' action: #cloneSimulationWindow; addLine; add: 'print ext head frame' action: #printExternalHeadFrame; add: 'print int head frame' action: #printHeadFrame; add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer]; add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP]; add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer]; add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP]; add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]]; add: 'print call stack' action: #printCallStack; add: 'print stack call stack' action: #printStackCallStack; + add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]]; add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]]; add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]]; add: 'print all stacks' action: #printAllStacks; add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP. self writeBackHeadFramePointers]; add: 'print prim trace log' action: #dumpPrimTraceLog; addLine; add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]]; add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]]; addLine; add: 'inspect object memory' target: objectMemory action: #inspect; add: 'inspect interpreter' action: #inspect; addLine; add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'. s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]]; add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'. s notEmpty ifTrue: [self setBreakSelector: s]]; add: 'turn valid exec ptrs assert o', (assertVEPAES ifTrue: ['ff'] ifFalse: ['n']) action: [assertVEPAES := assertVEPAES not]; add: (printSends ifTrue: ['no print sends'] ifFalse: ['print sends']) action: [self ensureDebugAtEachStepBlock. printSends := printSends not]; "currently printReturns does nothing" "add: (printReturns ifTrue: ['no print returns'] ifFalse: ['print returns']) action: [self ensureDebugAtEachStepBlock. printReturns := printReturns not];" add: (printBytecodeAtEachStep ifTrue: ['no print bytecode each bytecode'] ifFalse: ['print bytecode each bytecode']) action: [self ensureDebugAtEachStepBlock. printBytecodeAtEachStep := printBytecodeAtEachStep not]; add: (printFrameAtEachStep ifTrue: ['no print frame each bytecode'] ifFalse: ['print frame each bytecode']) action: [self ensureDebugAtEachStepBlock. printFrameAtEachStep := printFrameAtEachStep not]. ^aMenuMorph!

1 0

Re: [Pharo-dev] Should literals be immutable ?
by Eliot Miranda 28 Oct '14

28 Oct '14

On Mon, Oct 27, 2014 at 9:19 AM, Levente Uzonyi <leves(a)elte.hu> wrote: > On Mon, 27 Oct 2014, Clément Bera wrote: > > Hey guys, >> I was discussing about methods like that with Marcus: >> >> MyClass>>foo >> #(false) first >> ifFalse: [ >> 'first call since compilation' logCr. >> #(false) at: 1 put: true ] >> ifTrue: [ 'other calls' logCr ] >> >> DoIt: >> 4 timesRepeat: [MyClass new foo ] >> >> Transcript: >> 'first call since compilation' >> 'other calls' >> 'other calls' >> 'other calls' >> >> In the sista image/VM, we are most probably going with Eliot to implement >> a slow path when you edit the literal of a method (deoptimizing the method) >> so we can consider that the literals are immutable in the >> generic case (and if it's not true, execution falls back to a slow path). >> >> But I was thinking, does it worth it to implement the slow path ? >> Couldn't we just put literals as immutable all the time ? >> The methods as the one shown before would not work any more. But does >> someone use it ? >> > > This method was used in Seaside (or some Seaside extension) to cache the > contents of files in methods. > > By the way, how would you ensure immutability? > See my message earlier in the thread. Via a per-object isImmutable bit. > I mean, how would you prevent something like this? > > MyClass >> foo > > ^#('placeHolder') > > And then > > (((MyClass >> #foo) literalAt: 1) at: 1) becomeForward: Object new > > > Levente > > P.S.: why isn't this on the vm-dev list? > > >> ... >> >> >> -- best, Eliot

4 10

[commit][3116] More ARM linux loose ends.
by commits＠squeakvm.org 27 Oct '14

27 Oct '14

Revision: 3116 Author: eliot Date: 2014-10-27 11:59:12 -0700 (Mon, 27 Oct 2014) Log Message: ----------- More ARM linux loose ends. Modified Paths: -------------- branches/Cog/build.linux32ARM/HowToBuild branches/Cog/build.linux32ARM/squeak.stack.v3/build/plugins.ext branches/Cog/platforms/unix/plugins/BitBltPlugin/Makefile.inc branches/Cog/platforms/unix/vm-display-X11/Makefile.in Added Paths: ----------- branches/Cog/build.linux32ARM/asasm Modified: branches/Cog/build.linux32ARM/HowToBuild =================================================================== --- branches/Cog/build.linux32ARM/HowToBuild 2014-10-25 23:00:07 UTC (rev 3115) +++ branches/Cog/build.linux32ARM/HowToBuild 2014-10-27 18:59:12 UTC (rev 3116) @@ -11,6 +11,7 @@ - How to configure and build a VM on Unix - Testing an external plugin has completely linked - Optimization level and gcc version (please read!) + - BitBlt optimizations on ARM Overview @@ -183,7 +184,7 @@ N.B. If you're on a 64-bit linux read 3e below!! N.B. On Ubuntu *do not* supply "LIBS=-lpthread -luuid", i.e. use - ../../platforms/unix/config/configure --without-npsqueak CFLAGS="-g -O2 -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNDEBUG -DITIMER_HEARTBEAT=1 -DNO_VM_PROFILE=1 -DCOGMTVM=0 -DDEBUGVM=0" + ../platforms/unix/config/configure --without-npsqueak CFLAGS="-g -O2 -msse2 -D_GNU_SOURCE -D_FILE_OFFSET_BITS=64 -DNDEBUG -DITIMER_HEARTBEAT=1 -DNO_VM_PROFILE=1 -DCOGMTVM=0 -DDEBUGVM=0" N.B. The plugin set is defined by plugins.ext and plugins.int in the build dir. @@ -216,3 +217,14 @@ gcc version 3.4.6 20060404 (Red Hat 3.4.6-10) using -O2 results in a VM that segfaults early in startup. For these compilers it is probably wise to use -O1, even though -O3 seems to work. + + +BitBlt optimizations on ARM +--------------------------- +On ARM, BitBlt optimizations can be enbaled by including --enable-fast-bitblt as an option to ../platforms/unix/config/configure (default). +This requires the use of the assembler asasm (cf. http://lists.squeakfoundation.org/pipermail/vm-dev/2013-May/012959.html and http://forum.world.st/commit-2774-add-instructions-for-enableFastBlt-on-arm…). +However it is tricky to build from source and pre-packaged versions for Raspbian, Ubuntu, etc do not seem to be available. Therefore +asasm is included in Cog/build.linux32ARM/ as a pre-built binary. The Makefiles for BitBltPlugin and vm-display-X11 reference it directly. + + + Added: branches/Cog/build.linux32ARM/asasm =================================================================== (Binary files differ) Property changes on: branches/Cog/build.linux32ARM/asasm ___________________________________________________________________ Added: svn:executable + * Added: svn:mime-type + application/octet-stream Modified: branches/Cog/build.linux32ARM/squeak.stack.v3/build/plugins.ext =================================================================== --- branches/Cog/build.linux32ARM/squeak.stack.v3/build/plugins.ext 2014-10-25 23:00:07 UTC (rev 3115) +++ branches/Cog/build.linux32ARM/squeak.stack.v3/build/plugins.ext 2014-10-27 18:59:12 UTC (rev 3116) @@ -6,5 +6,4 @@ UnicodePlugin \ UnixOSProcessPlugin \ UUIDPlugin \ -SqueakFFIPrims \ XDisplayControlPlugin Modified: branches/Cog/platforms/unix/plugins/BitBltPlugin/Makefile.inc =================================================================== --- branches/Cog/platforms/unix/plugins/BitBltPlugin/Makefile.inc 2014-10-25 23:00:07 UTC (rev 3115) +++ branches/Cog/platforms/unix/plugins/BitBltPlugin/Makefile.inc 2014-10-27 18:59:12 UTC (rev 3116) @@ -2,4 +2,4 @@ XCFLAGS = $(BITBLT_FLAGS) ASMINCLUDES = -I$(topdir)/platforms/Cross/plugins/BitBltPlugin ASMFLAGS = -cpu=$(ARM_ARCH) -AS = asasm $(ASMFLAGS) $(ASMINCLUDES) -o \ No newline at end of file +AS = $(blddir)/../../asasm $(ASMFLAGS) $(ASMINCLUDES) -o \ No newline at end of file Modified: branches/Cog/platforms/unix/vm-display-X11/Makefile.in =================================================================== --- branches/Cog/platforms/unix/vm-display-X11/Makefile.in 2014-10-25 23:00:07 UTC (rev 3115) +++ branches/Cog/platforms/unix/vm-display-X11/Makefile.in 2014-10-27 18:59:12 UTC (rev 3116) @@ -46,7 +46,7 @@ XCFLAGS = $(VM_DISPX11_BITBLT_FLAGS) ASMINCLUDES = -I$(topdir)/platforms/Cross/plugins/BitBltPlugin ASMFLAGS = -cpu=$(ARM_ARCH) -AS = asasm $(ASMFLAGS) $(ASMINCLUDES) -o +AS = $(blddir)/../../asasm $(ASMFLAGS) $(ASMINCLUDES) -o XINCLUDES = [includes] $(X_INCLUDES) \ -I$(topdir)/platforms/Cross/plugins/FilePlugin \

1 0

Re: [Pharo-dev] Should literals be immutable ?
by Eliot Miranda 27 Oct '14

27 Oct '14

Hi Clément, IMO literals should be immutable all the time, and IMO the best way is via a per-object isImmutable bit. We implemented this for VW in 7.0 and it was a positive experience. I've implemented the "create an immutable subclass for each literal class" and it has lots of problems (thing printString or storeString having to produce something like 'an immutable string' asMutableString for a normal string). The per-object bit has other uses too. Object databases such as GemStone can use it to make write-through scheme efficient. The only problem we had was dealing with broken user code that was depending on mutable literals. This is of course a bug, but folks thought we shouldn't just break user code so Alan Knight provided a system setting that write a warning to the transcript and updated the literal instead if raising an error. That's easy to do, if IMO dubious. Fixing the code is as easy as sending copy to the literal in question, the copy being mutable. Now I implemented the per-object bit for the Newspeak interpreter WM so you'll find lots of the necessary work is there waiting to be ported to the Stack and Cog VMs. I've not had the time to implement the JIT support to catch inst var and at:put: writes to immutables. But it shouldn't be too much work. Volunteers? Eliot (phone) On Oct 27, 2014, at 8:22 AM, Clément Bera <bera.clement(a)gmail.com> wrote: > Hey guys, > > I was discussing about methods like that with Marcus: > > MyClass>>foo > #(false) first > ifFalse: [ > 'first call since compilation' logCr. > #(false) at: 1 put: true ] > ifTrue: [ 'other calls' logCr ] > > DoIt: > 4 timesRepeat: [MyClass new foo ] > > Transcript: > 'first call since compilation' > 'other calls' > 'other calls' > 'other calls' > > In the sista image/VM, we are most probably going with Eliot to implement a slow path when you edit the literal of a method (deoptimizing the method) so we can consider that the literals are immutable in the generic case (and if it's not true, execution falls back to a slow path). > > But I was thinking, does it worth it to implement the slow path ? > Couldn't we just put literals as immutable all the time ? > The methods as the one shown before would not work any more. But does someone use it ? > > ... >

1 0

Retina resolution?
by Bernhard Pieber 27 Oct '14

27 Oct '14

Dear VM machininsts, I have a new MacBook with Retina dispay with a resolution of 2560 x 1600. However, with the latest Cog VM 3114 I only get a quarter of that (1280@800). I am on OS X 10.10. Is there a way to configure the VM to get the full resolution or is a VM change needed for that? Cheers, Bernhard

3 2

primitiveClipboardText mangling line endings
by Levente Uzonyi 26 Oct '14

26 Oct '14

Hi All, I found that it's impossile to copy text from one image to another without losing all CR characters. If you open two images, and evaluate [Clipboard default primitiveClipboardText: #[13].] in one of them, then evaluate [Clipboard default primitiveClipboardText asByteArray.] in the other, you'll get #[] - an empty ByteArray. So CRs are lost. The same thing happens with longer strings too. Using the same method, I found that LFs and CRLFs are converted to CRs. I found this issue on Ubuntu 14.04 with Cog 3018 and 3104. I haven't tried any other VMs or OSes. Levente

4 6

Re: [Pharo-dev] Run Spur run!!
by Eliot Miranda 26 Oct '14

26 Oct '14

On Oct 26, 2014, at 8:58 AM, stepharo <stepharo(a)free.fr> wrote: > >> >> Yes, I'm very excited. It's so great to have strong collaborators like Clément, Ronie, Doug and Tim. But there's lots of room for more to join us. For a really cool project how about grabbing Bert Freudenberg's VMMakerJS Squeak-vm-on-JavaScript, extract the event handling and rendering part and connect it to the Cog VM via sockets to give us a really fast web plugin? > > I thought that the event handling was what JB is doing with the idle process on android. These are two different, but closely related things. The event-driven VM and idle process work gives us better event handling (no event queue, important for better integration with GUIs) and a cheaper VM at idle (the CM blocks awaiting an event instead of spinning calling a shirt delay). To embed the system in a web browser one needs both to render to the browser window and to receive mouse and keyboard events from the window. So the "plugin" must be connected to the VM's event subsystem e.g. by a socket. Just as the VM's graphics subsystem must output to the browser window. There are lots of ways to slice this and it will likely be different for BitBlt and Athens. Eliot (phone) > > Stef >> >> -- >> best, >> Eliot > >

2 2

Re: [Vm-dev] [squeak-dev] re: Image Segment semantics and weakness
by Eliot Miranda 26 Oct '14

26 Oct '14

Hi Stephane, Hi All, let me talk a little about the ParcPlace experience, which led to David Leibs' parcels, whose architecture Fuel uses. In the late 80's 90's Peter Deutsch write BOSS (Binary Object Storage System), a traditional interpretive pickling system defined by a little bytecoded language. Think of a bytecode as something like "What follows is an object definition, which is its id followed by size info followed by the definitions or ids of its sub-parts, including its class", or "What follows is the id of an already defined object". So the loading interpreter looks at the next byte in the stream and that tells it what to do. So the storage is a recursive definition of a graph, much like a recursive grammar for a programming language. This approach is slow (its a bytecode interpreter) and fragile (structures in the process of being built aren't valid yet, imagine trying to take the hash of a Set that is only half-way through being materialized). But this architecture was very common at the time (I wrote something very similar). The advantage BOSS had was a clumsy hack for versioning. One could specify blocks that were supplied with the version and state of older objects, and these blocks could effect shape change etc to bring loaded instances up-to-date. David Leibs has an epiphany as, in the early 90's, ParcPlae was trying to decompose the VW image (chainsaw was the code name of the VW 2.5 release). If one groups instances by class, one can instantiate in bulk, creating all the instances of a particular class in one go, followed by all the instances of a different class, etc. Then the arc information (the pointers to objects to be stored in the loaded objects inst vars) can follow the instance information. So now the file looks like header, names of classes that are referenced (not defined), definitions of classes, definitions of instances (essentially class id, count pairs), arc information. And materializing means finding the classes in the image, creating the classes in the file, creating the instances, stitching the graph together, and then performing any post-load actions (rehashing instances, etc). Within months we merged with Digitalk (to form DarcPlace-Dodgytalk) and were introduced to TeamV's loading model which was very much like ImageSegments, being based on the VM's object format. Because an ImageSegment also has imports (references to classes and globals taken from the host system, not defined in the file) performance doesn't just depend on loading the segment into memorty. It also depends on how long it takes to search the system to find imports, etc. In practice we found that a) Parcels were 4 times faster than BOSS, and b) they were no slower than Digitalk's image segments. But being independent of the VM's heap format Parcels had BOSS's flexibility and could support shape change on load, something ImageSegments *cannot do*. I went on to extend parcels with support for shape change, plus support for partial loading of code, but I won't describe that here. Too detailed, even thought its very important. Mariano spent time talking with me and Fuel's basic architecture is that of parcels, but reimplemented to be nicer, more flexible etc. But essentially Parcels and Fuel are at their core David Leibs' invention. He came up with the ideas of a) grouping objects by class and b) separating the arcs from the nodes. Now, where ImageSegments are faster than Parcels is *not* loading. Our experience with VW vs TeamV showed us that. But they are faster in collecting the graph of objects to be included. ImageSegments are dead simple. So IMO the right architecture is to use Parcels' segregation, and Parcels' "abstract" format (independent of the heap object format) with ImageSegment's computation of the object graph. Igor Stasenko has suggested providing the tracing part of ImageSegments (Dan Ingalls' cool invention of mark the segment root objects, then mark the heap, leaving the objects to be stored unmarked in the shadow of the marked segment roots) as a separate primitive. Then this can be quickly partitioned by class and then written by Smalltalk code. The loader can then materialize objects using Smalltalk code, can deal with shape change, and not be significantly slower than image segments. Crucially this means that one has a portable, long-lived object storage format; freeing the VM to evolve its object format without breaking image segments with every change to the object format. I'd be happy to help people working on Fuel by providing that primitive for anyone who wants to try and reimplement the ImageSegment functonality (project saving, class faulting, etc) above Fuel. On Wed, Oct 22, 2014 at 11:56 AM, Stéphane Ducasse < stephane.ducasse(a)inria.fr> wrote: > What I can tell you is that instability raised by just having one single > pointer not in the root objects > pointing to an element in the segment and the implication of this pointer > on reloaded segments, (yes I do not want to have two objects in memory > after loading) makes sure that we will not use IS primitive in Pharo in any > future. For us this is a non feature. > > IS was a nice trick but since having a pointer to an object is so cheap > and the basis of our computational model > so this is lead fo unpredictable side effects. We saw that when mariano > worked during the first year of his PhD (which is a kind of LOOM revisit). > > Stef > -- best, Eliot

8 10

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev October 2014