Vm-dev September 2013

vm-dev@lists.squeakfoundation.org

31 participants
155 discussions

VM Maker: VMMaker.oscog-eem.395.mcz
by commits＠source.squeak.org 20 Sep '13

20 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.395.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.395 Author: eem Time: 20 September 2013, 10:16:00.574 am UUID: eb6732e4-5b88-48f9-b18c-1b613f234197 Ancestors: VMMaker.oscog-eem.394 Fix bug due to use of startOfFreeChunk: which assumed all free chunks have a two=word header. Easier to keep them like normal objects with an optional overflow size depending on slot size. Consequently, make startOfObject: accept any kind of object. More protocol. Bootstrap now continues until out-of-memory (cuz boostrap doesn't allocate enough). =============== Diff against VMMaker.oscog-eem.394 =============== Item was added: + ----- Method: Spur32BitMMLESimulator>>is:KindOf: (in category 'simulation only') ----- + is: oop KindOf: classNameString + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter is: oop KindOf: classNameString! Item was changed: ----- Method: Spur32BitMMLESimulator>>longAt:put: (in category 'memory access') ----- longAt: byteAddress put: a32BitValue "Note: Adjusted for Smalltalk's 1-based array indexing." + "(byteAddress = 16r120DBDC and: [a32BitValue = 16r16000000]) ifTrue: + [self halt]." byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError]. ^memory at: byteAddress // 4 + 1 put: a32BitValue! Item was changed: ----- Method: Spur32BitMMLESimulator>>longLongAt:put: (in category 'memory access') ----- longLongAt: byteAddress put: a64BitValue "memory is a Bitmap, a 32-bit indexable array of bits" byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError]. + ((byteAddress = 16r120DBDC or: [byteAddress = 16r120DBD8]) + and: [a64BitValue >> 32 = 16r16000000 + or: [(a64BitValue bitAnd: 16rffffffff) = 16r16000000]]) ifTrue: + [self halt]. memory at: byteAddress // 4 + 1 put: (a64BitValue bitAnd: 16rffffffff); at: byteAddress // 4 + 2 put: a64BitValue >> 32. ^a64BitValue! Item was added: + ----- Method: Spur32BitMMLESimulator>>methodArgumentCount (in category 'simulation only') ----- + methodArgumentCount + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter methodArgumentCount! Item was added: + ----- Method: Spur32BitMMLESimulator>>pop: (in category 'simulation only') ----- + pop: nItems + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter pop: nItems! Item was changed: ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') ----- allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex + "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header + will have been filled-in but not the contents." + | bytes chunk | - | bytes freeChunk chunk | bytes := self objectBytesForSlots: numSlots. + chunk := self allocateOldSpaceChunkOfBytes: bytes. + chunk ifNil: - freeChunk := self allocateOldSpaceChunkOfBytes: bytes. - freeChunk ifNil: [^nil]. - chunk := self startOfFreeChunk: freeChunk. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: chunk put: numSlots. self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift. self longLongAt: chunk + self baseHeaderSize put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). ^chunk + self baseHeaderSize]. self longLongAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). ^chunk! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes "Answer a chunk of oldSpace from the free lists, if available, otherwise answer nil. N.B. the chunk is simply a pointer, it has no valid header. The caller *must* fill in the header correctly." | index chunk nextIndex nodeBytes parent child smaller larger | index := chunkBytes / self allocationUnit. (index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: + [self assert: chunk = (self startOfObject: chunk). + ^self unlinkFreeChunk: chunk atIndex: index]. - [^self unlinkFreeChunk: chunk atIndex: index]. "first search for free chunks of a multiple of chunkBytes in size" nextIndex := index. [1 << index >= freeListsMask and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue: [((freeListsMask anyMask: 1 << index) and: [(chunk := freeLists at: index) ~= 0]) ifTrue: + [self assert: chunk = (self startOfObject: chunk). + self unlinkFreeChunk: chunk atIndex: index. - [self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes + at: (self startOfObject: chunk) + chunkBytes. - at: (self startOfFreeChunk: chunk) + chunkBytes. ^chunk]]. "now get desperate and use the first that'll fit" nextIndex := index. [1 << index >= freeListsMask and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: + [self assert: chunk = (self startOfObject: chunk). + self unlinkFreeChunk: chunk atIndex: index. - [self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes + at: (self startOfObject: chunk) + chunkBytes. - at: (self startOfFreeChunk: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]]. "Large chunk, or no space on small free lists. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [nodeBytes := self bytesInObject: child. parent := child. nodeBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). ^chunk]. child := 0] "break out of loop to remove interior node" ifFalse:"walk down the tree" [child := self fetchPointer: (nodeBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: child]]. parent = 0 ifTrue: [self halt]. "self printFreeChunk: parent" self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: parent withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes + at: (self startOfObject: chunk) + chunkBytes]. + ^self startOfObject: chunk]. - at: (self startOfFreeChunk: chunk) + chunkBytes]. - ^chunk]. "no list; remove an interior node" chunk := parent. parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. "no parent; stitch the subnodes back into the root" parent = 0 ifTrue: [smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. smaller = 0 ifTrue: [freeLists at: 0 put: larger] ifFalse: [freeLists at: 0 put: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]. "coInterpreter transcript ensureCr. coInterpreter print: 'new free tree root '. (freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)]. coInterpreter cr." chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes + at: (self startOfObject: chunk) + chunkBytes]. + ^self startOfObject: chunk]. - at: (self startOfFreeChunk: chunk) + chunkBytes]. - ^chunk]. "remove node from tree; reorder tree simply. two cases (which have mirrors, for four total): case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | S | _/_ | S |" self halt. "case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree. add the left subtree to the bottom left of the right subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | R | _/_ _\_ _/_ | L | | R | | L |" self halt! Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop "This list records the valid senders of isIntegerObject: as we replace uses of isIntegerObject: by isImmediate: where appropriate." (#( DoIt DoItIn: makeBaseFrameFor: quickFetchInteger:ofObject: frameOfMarriedContext: objCouldBeClassObj: isMarriedOrWidowedContext: shortPrint: bytecodePrimAt bytecodePrimAtPut commonAt: commonAtPut: loadFloatOrIntFrom: positive32BitValueOf: primitiveExternalCall checkedIntegerValueOf: bytecodePrimAtPut commonAtPut: primitiveVMParameter checkIsStillMarriedContext:currentFP: displayBitsOf:Left:Top:Right:Bottom: fetchStackPointerOf: primitiveContextAt primitiveContextAtPut subscript:with:storing:format: printContext: compare31or32Bits:equal: signed64BitValueOf: primDigitMultiply:negative: digitLength: isNegativeIntegerValueOf: magnitude64BitValueOf: primitiveMakePoint primitiveAsCharacter primitiveInputSemaphore baseFrameReturn + primitiveExternalCall + primDigitCompare: + isLiveContext:) includes: thisContext sender method selector) ifFalse: - primitiveExternalCall) includes: thisContext sender method selector) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0! Item was removed: - ----- Method: SpurMemoryManager>>startOfFreeChunk: (in category 'free space') ----- - startOfFreeChunk: freeChunk - ^freeChunk - self baseHeaderSize! Item was changed: ----- Method: SpurMemoryManager>>startOfObject: (in category 'object enumeration') ----- startOfObject: objOop "Answer the start of objOop, which is either the address of the overflow size word, + or objOop itself, depending on the size of the object. This may be applied to + any kind of object, normal, forwarders or free chunks." + ^(self numSlotsOfAny: objOop) >= self numSlotsMask - or objOop itself, depending on the size of the object." - ^(self numSlotsOf: objOop) >= self numSlotsMask ifTrue: [objOop - self baseHeaderSize] ifFalse: [objOop]! Item was changed: ----- Method: StackInterpreter>>flushExternalPrimitives (in category 'plugin primitive support') ----- flushExternalPrimitives + "Flush the references to external functions from plugin primitives. + This will force a reload of those primitives when accessed next. + Note: We must flush the method cache here also, so that any failed + primitives are looked up again." + objectMemory allObjectsDo: + [:oop| | primIdx | + (objectMemory isFreeObject: oop) ifFalse: + [(objectMemory isCompiledMethod: oop) ifTrue: "This is a compiled method" + [primIdx := self primitiveIndexOf: oop. + primIdx = PrimitiveExternalCallIndex ifTrue: "It's primitiveExternalCall" + [self flushExternalPrimitiveOf: oop]]]]. - "Flush the references to external functions from plugin - primitives. This will force a reload of those primitives when - accessed next. - Note: We must flush the method cache here so that any - failed primitives are looked up again." - | oop primIdx | - oop := objectMemory firstObject. - [self oop: oop isLessThan: objectMemory freeStart] - whileTrue: [(objectMemory isFreeObject: oop) - ifFalse: [(objectMemory isCompiledMethod: oop) - ifTrue: ["This is a compiled method" - primIdx := self primitiveIndexOf: oop. - primIdx = PrimitiveExternalCallIndex - ifTrue: ["It's primitiveExternalCall" - self flushExternalPrimitiveOf: oop]]]. - oop := objectMemory objectAfter: oop]. self flushMethodCache. self flushAtCache. self flushExternalPrimitiveTable!

1 0

VM Maker: Cog-eem.94.mcz
by commits＠source.squeak.org 20 Sep '13

20 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.94.mcz ==================== Summary ==================== Name: Cog-eem.94 Author: eem Time: 20 September 2013, 10:17:43.755 am UUID: 2eb57a41-e430-4174-a21c-2ec84cc5fdc6 Ancestors: Cog-eem.93 SpurBootstrap: Remember to flush external primitives. =============== Diff against Cog-eem.93 =============== Item was changed: ----- Method: SpurBootstrap>>launch:headerFlags: (in category 'testing') ----- launch: heap headerFlags: headerFlags | sim | sim := StackInterpreterSimulator onObjectMemory: heap. heap coInterpreter: sim. sim initializeInterpreter: 0; setImageHeaderFlagsFrom: headerFlags; imageName: ImageName; + flushExternalPrimitives; openAsMorph; transcript: Transcript. "deep copy copies this" "sim instVarNamed: 'printSends' put: true; instVarNamed: 'printReturns' put: true; instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal." "for now" + heap setCheckForLeaks: 15. + sim halt; run! - sim run! Item was changed: ----- Method: SpurBootstrap>>on: (in category 'initialize-release') ----- on: imageName StackInterpreter initializeWithOptions: Dictionary new. oldInterpreter := StackInterpreterSimulator new. oldInterpreter openOn: imageName extraMemory: 0. oldHeap := oldInterpreter objectMemory. newHeap := Spur32BitMMLESimulator new. newHeap allocateMemoryOfSize: (oldHeap youngStart * 5 / 4 roundUpTo: 8) newSpaceSize: 1024 * 1024 codeSize: 1024 * 1024. + newHeap setCheckForLeaks: 15 - 4. "don't check become" - newHeap setCheckForLeaks: 15 - 4. "don't check become" map := Dictionary new: oldHeap memory size // 4. reverseMap := Dictionary new: oldHeap memory size // 4. classToIndex := Dictionary new: 1024. literalMap := IdentityDictionary new. methodClasses := Set new. installedPrototypes := Set new!

1 0

VM Maker: Cog-eem.93.mcz
by commits＠source.squeak.org 20 Sep '13

20 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.93.mcz ==================== Summary ==================== Name: Cog-eem.93 Author: eem Time: 19 September 2013, 4:44:22.202 pm UUID: d40f263c-8701-47f1-9fd8-1f95802ab49a Ancestors: Cog-eem.92 SpurBootstrap: Change save & launch to save & set imageHeaderFlags & imageName. Quick hack to avoid having to write image save/load logic now. Needs VMMaker.oscog-eem.394 =============== Diff against Cog-eem.92 =============== Item was changed: Object subclass: #SpurBootstrap instanceVariableNames: 'oldHeap newHeap map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes sizeSym rehashSym' + classVariableNames: 'ImageHeaderFlags ImageName TransformedImage' - classVariableNames: 'NewInterpreter TransformedImage' poolDictionaries: 'VMObjectIndices' category: 'Cog-Bootstrapping'! !SpurBootstrap commentStamp: 'eem 9/11/2013 05:45' prior: 0! SpurBootstrap bootstraps an image in SpurMemoryManager format from a Squeak V3 + closures format. e.g. (SpurBootstrap32 new on: '/Users/eliot/Cog/startreader.image') transform; launch Bootstrap issues: - should it implement a deterministic Symbol identityHash? This means set a Symbol's identityHash at instance creation time based on its string hash so that e.g. MethodDIctionary instances have a deterministic order and don't need to be rehashed on load. - should it collapse ContextPart and MethodContext down onto Context (and perhaps eliminate BlockContext)? Instance Variables classToIndex: <Dictionary> lastClassTablePage: <Integer> map: <Dictionary> methodClasses: <Set> newHeap: <SpurMemoryManager> oldHeap: <NewObjectMemory> oldInterpreter: <StackInterpreterSimulator> reverseMap: <Dictionary> symbolMap: <Dictionary> classToIndex - oldClass to new classIndex map lastClassTablePage - oop in newHeap of last classTable page. U<sed in validation to filter-out class table. methodClasses - cache of methodClassAssociations for classes in which modified methods are installed map - oldObject to newObject map newHeap - the output, bootstrapped image oldHeap - the input, image oldInterpreter - the interpreter associated with oldHeap, needed for a hack to grab WeakArray reverseMap - newObject to oldObject map symbolMap - symbol toi symbol oop in oldHeap, used to map prototype methdos to methods in oldHeap! Item was changed: ----- Method: SpurBootstrap>>launch (in category 'testing') ----- launch + self launch: newHeap headerFlags: oldInterpreter getImageHeaderFlags! - self launch: newHeap! Item was removed: - ----- Method: SpurBootstrap>>launch: (in category 'testing') ----- - launch: heap - | sim | - sim := StackInterpreterSimulator onObjectMemory: heap. - heap coInterpreter: sim. - sim - initializeInterpreter: 0; - transcript: Transcript. "deep copy copies this" - sim - instVarNamed: 'printSends' put: true; - instVarNamed: 'printReturns' put: true; - instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal. "for now" - sim run! Item was added: + ----- Method: SpurBootstrap>>launch:headerFlags: (in category 'testing') ----- + launch: heap headerFlags: headerFlags + | sim | + sim := StackInterpreterSimulator onObjectMemory: heap. + heap coInterpreter: sim. + sim + initializeInterpreter: 0; + setImageHeaderFlagsFrom: headerFlags; + imageName: ImageName; + openAsMorph; + transcript: Transcript. "deep copy copies this" + "sim + instVarNamed: 'printSends' put: true; + instVarNamed: 'printReturns' put: true; + instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal." "for now" + sim run! Item was changed: ----- Method: SpurBootstrap>>launchSaved (in category 'testing') ----- launchSaved + self launch: TransformedImage veryDeepCopy headerFlags: ImageHeaderFlags! - self launch: TransformedImage veryDeepCopy! Item was changed: ----- Method: SpurBootstrap>>saveTransformedImage (in category 'development support') ----- saveTransformedImage + ImageHeaderFlags := oldInterpreter getImageHeaderFlags. + ImageName := oldInterpreter imageName. newHeap coInterpreter: nil. TransformedImage := newHeap veryDeepCopy!

1 0

VM Maker: VMMaker.oscog-eem.394.mcz
by commits＠source.squeak.org 20 Sep '13

20 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.394.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.394 Author: eem Time: 19 September 2013, 4:41:40.51 pm UUID: ecd45400-0d67-4c39-9c8b-3210cf96a58b Ancestors: VMMaker.oscog-eem.393 Rewrite send fault logic to do a 1st-level method lookup cache probe after handling the send fault. rename the handler to handleForwardedSendFaultFor:. Implement SMM>>byteSizeOf:. Change the interpreter proxy API to include characterObjectOf: and use it in FilePlugin>>primitiveDirectoryDelimitor. Nuke unused method. =============== Diff against VMMaker.oscog-eem.393 =============== Item was changed: ----- Method: FilePlugin>>primitiveDirectoryDelimitor (in category 'directory primitives') ----- primitiveDirectoryDelimitor | ascii | <export: true> ascii := self asciiDirectoryDelimiter. + interpreterProxy minorVersion >= 13 + ifTrue: + [interpreterProxy + pop: 1 + thenPush: (interpreterProxy characterObjectOf: ascii)] + ifFalse: + [(ascii >= 0 and: [ascii <= 255]) + ifTrue: + [interpreterProxy + pop: 1 + thenPush: (interpreterProxy + fetchPointer: ascii + ofObject: interpreterProxy characterTable)] + ifFalse: + [interpreterProxy primitiveFail]]! - ((ascii >= 0) and: [ascii <= 255]) ifFalse: - [^interpreterProxy primitiveFail]. - interpreterProxy - pop: 1 - thenPush: (interpreterProxy fetchPointer: ascii ofObject: (interpreterProxy characterTable))! Item was changed: + ----- Method: Spur32BitMMLESimulator>>booleanValueOf: (in category 'simulation only') ----- - ----- Method: Spur32BitMMLESimulator>>booleanValueOf: (in category 'C library simulation') ----- booleanValueOf: obj "hack around the CoInterpreter/ObjectMemory split refactoring" ^coInterpreter booleanValueOf: obj! Item was added: + ----- Method: Spur32BitMMLESimulator>>ioLoadFunction:From: (in category 'simulation only') ----- + ioLoadFunction: functionString From: pluginString + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter ioLoadFunction: functionString From: pluginString! Item was removed: - ----- Method: Spur32BitMMLESimulator>>is:KindOf: (in category 'simulation only') ----- - is: oop KindOf: classNameString - "hack around the CoInterpreter/ObjectMemory split refactoring" - ^coInterpreter is: oop KindOf: classNameString! Item was removed: - ----- Method: Spur32BitMMLESimulator>>methodArgumentCount (in category 'simulation only') ----- - methodArgumentCount - "hack around the CoInterpreter/ObjectMemory split refactoring" - ^coInterpreter methodArgumentCount! Item was changed: ----- Method: SpurMemoryManager class>>vmProxyMinorVersion (in category 'simulation only') ----- vmProxyMinorVersion "hack around the CoInterpreter/ObjectMemory split refactoring" + ^StackInterpreter vmProxyMinorVersion max: 13! - ^StackInterpreter vmProxyMinorVersion! Item was added: + ----- Method: SpurMemoryManager>>byteSizeOf: (in category 'object access') ----- + byteSizeOf: oop + <api> + | format | + (self isImmediate: oop) ifTrue: [^0]. + format := self formatOf: oop. + format < self sixtyFourBitIndexableFormat ifTrue: + [^(self numSlotsOf: oop) << self shiftForWord]. + format >= self firstByteFormat ifTrue: + [^(self numSlotsOf: oop) << self shiftForWord - (format bitAnd: 7)]. + format >= self firstShortFormat ifTrue: + [^(self numSlotsOf: oop) << self shiftForWord - ((format bitAnd: 3) << 1)]. + format >= self firstLongFormat ifTrue: + [^(self numSlotsOf: oop) << self shiftForWord - ((format bitAnd: 1) << 2)]. + ^(self numSlotsOf: oop) << self shiftForWord! Item was added: + ----- Method: SpurMemoryManager>>interpreter (in category 'simulation') ----- + interpreter + <doNotGenerate> + ^coInterpreter! Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop "This list records the valid senders of isIntegerObject: as we replace uses of isIntegerObject: by isImmediate: where appropriate." (#( DoIt DoItIn: makeBaseFrameFor: quickFetchInteger:ofObject: frameOfMarriedContext: objCouldBeClassObj: isMarriedOrWidowedContext: shortPrint: bytecodePrimAt bytecodePrimAtPut commonAt: commonAtPut: loadFloatOrIntFrom: positive32BitValueOf: primitiveExternalCall checkedIntegerValueOf: bytecodePrimAtPut commonAtPut: primitiveVMParameter checkIsStillMarriedContext:currentFP: displayBitsOf:Left:Top:Right:Bottom: fetchStackPointerOf: primitiveContextAt primitiveContextAtPut subscript:with:storing:format: printContext: compare31or32Bits:equal: signed64BitValueOf: primDigitMultiply:negative: digitLength: isNegativeIntegerValueOf: magnitude64BitValueOf: + primitiveMakePoint + primitiveAsCharacter + primitiveInputSemaphore + baseFrameReturn + primitiveExternalCall) includes: thisContext sender method selector) ifFalse: - primitiveMakePoint) includes: thisContext sender method selector) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0! Item was changed: ----- Method: StackInterpreter>>findNewMethodInClassTag: (in category 'message sending') ----- findNewMethodInClassTag: classTag "Find the compiled method to be run when the current messageSelector is sent to the given class, setting the values of 'newMethod' and 'primitiveIndex'." | ok class | <inline: false> ok := self lookupInMethodCacheSel: messageSelector classTag: classTag. ok ifFalse: "entry was not found in the cache; look it up the hard way " + [(objectMemory isForwardedClassTag: lkupClassTag) ifTrue: + [lkupClassTag := self handleForwardedSendFaultFor: lkupClassTag. + ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag. + ok ifTrue: + [^nil]]. + class := objectMemory classForClassTag: classTag. - [class := self sendFaultFor: classTag. self lookupMethodInClass: class. self addNewMethodToCache: class]! Item was added: + ----- Method: StackInterpreter>>handleForwardedSendFaultFor: (in category 'message sending') ----- + handleForwardedSendFaultFor: classTag + "Handle a send fault that may be due to a send to a forwarded object. + Unforward the receiver on the stack and answer its actual class." + | rcvr | + (objectMemory isForwardedClassTag: classTag) ifFalse: + [^classTag]. + + rcvr := self stackValue: argumentCount. + "should *not* be a super send, so te receiver should be forwarded." + self assert: (objectMemory isOopForwarded: rcvr). + rcvr := objectMemory followForwarded: rcvr. + self stackValue: argumentCount put: rcvr. + self followForwardedFrameContents: framePointer + stackPointer: stackPointer + (argumentCount + 1 * BytesPerWord). "don't repeat effort" + (objectMemory isPointers: (self frameReceiver: framePointer)) ifTrue: + [objectMemory + followForwardedObjectFields: (self frameReceiver: framePointer) + toDepth: 0]. + ^objectMemory fetchClassTagOf: rcvr! Item was changed: ----- Method: StackInterpreter>>iframeInstructionPointerForIndex:method: (in category 'frame access') ----- iframeInstructionPointerForIndex: ip method: aMethod "Answer the instruction pointer for use in an interpreter frame (a pointer to a bytecode)." + self assert: (ip between: (objectMemory lastPointerOf: aMethod) - 1 + and: (objectMemory lengthOf: aMethod)). + ^aMethod + ip + objectMemory baseHeaderSize - 2! - self assert: (ip between: (objectMemory lastPointerOf: aMethod) and: (objectMemory lengthOf: aMethod)). - ^aMethod + ip + BaseHeaderSize - 2! Item was changed: ----- Method: StackInterpreter>>internalFindNewMethod (in category 'message sending') ----- internalFindNewMethod "Find the compiled method to be run when the current messageSelector is sent to the class 'lkupClass', setting the values of 'newMethod' and 'primitiveIndex'." | ok | <inline: true> ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag. ok ifFalse: "entry was not found in the cache; look it up the hard way" [self externalizeIPandSP. + (objectMemory isForwardedClassTag: lkupClassTag) ifTrue: + [lkupClassTag := self handleForwardedSendFaultFor: lkupClassTag. + ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag. + ok ifTrue: + [^nil]]. + lkupClass := objectMemory classForClassTag: lkupClassTag. - lkupClass := self sendFaultFor: lkupClassTag. self lookupMethodInClass: lkupClass. self internalizeIPandSP. self addNewMethodToCache: lkupClass]! Item was removed: - ----- Method: StackInterpreter>>sendFaultFor: (in category 'message sending') ----- - sendFaultFor: classTag - "Handle a send fault that may be due to a send to a forwarded object. - Unforward the receiver on the stack and answer its actual class." - | rcvr | - (objectMemory isForwardedClassTag: classTag) ifFalse: - [^objectMemory classForClassTag: classTag]. - - rcvr := self stackValue: argumentCount. - "should *not* be a super send, so te receiver should be forwarded." - self assert: (objectMemory isOopForwarded: rcvr). - rcvr := objectMemory followForwarded: rcvr. - self stackValue: argumentCount put: rcvr. - self followForwardedFrameContents: framePointer - stackPointer: stackPointer + (argumentCount + 1 * BytesPerWord). "don't repeat effort" - (objectMemory isPointers: (self frameReceiver: framePointer)) ifTrue: - [objectMemory - followForwardedObjectFields: (self frameReceiver: framePointer) - toDepth: 0]. - ^objectMemory fetchClassOf: rcvr! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveSignalAtMilliseconds (in category 'system control primitives') ----- primitiveSignalAtMilliseconds "Cause the time semaphore, if one has been registered, to be signalled when the microsecond clock is greater than or equal to the given tick value. A tick value of zero turns off timer interrupts." | msecsObj msecs deltaMsecs sema | <var: #msecs type: #usqInt> msecsObj := self stackTop. sema := self stackValue: 1. msecs := self positive32BitValueOf: msecsObj. (self failed + or: [objectMemory isImmediate: sema]) ifTrue: - or: [objectMemory isIntegerObject: sema]) ifTrue: [self primitiveFail. ^nil]. (objectMemory fetchClassOfNonImm: sema) = (objectMemory splObj: ClassSemaphore) ifTrue: [objectMemory splObj: TheTimerSemaphore put: sema. deltaMsecs := msecs - (self ioMSecs bitAnd: MillisecondClockMask). deltaMsecs < 0 ifTrue: [deltaMsecs := deltaMsecs + MillisecondClockMask + 1]. nextWakeupUsecs := self ioUTCMicroseconds + (deltaMsecs * 1000)] ifFalse: [objectMemory storePointer: TheTimerSemaphore ofObject: objectMemory specialObjectsOop withValue: objectMemory nilObject. nextWakeupUsecs := 0]. self pop: 2! Item was added: + ----- Method: StackInterpreterSimulator>>imageName (in category 'spur bootstrap') ----- + imageName + ^imageName! Item was added: + ----- Method: StackInterpreterSimulator>>imageName: (in category 'spur bootstrap') ----- + imageName: aString + imageName := aString! Item was removed: - ----- Method: VMClass class>>emitInterpreterProxyVersionOn: (in category 'api version') ----- - emitInterpreterProxyVersionOn: aStream - aStream - nextPutAll: '#define VM_PROXY_MAJOR '; print: self vmProxyMajorVersion; cr; - nextPutAll: '#define VM_PROXY_MINOR '; print: self vmProxyMinorVersion; cr; cr!

1 0

VM Maker: VMMaker.oscog-eem.393.mcz
by commits＠source.squeak.org 19 Sep '13

19 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.393.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.393 Author: eem Time: 19 September 2013, 2:39:25.571 pm UUID: 89054bad-ac17-46e1-916f-9728d3774f3e Ancestors: VMMaker.oscog-eem.392 Replace eeInstantiateSmallClass:sizeInBytes: with eeInstantiateSmallClass:numSlots: and implement in SpurMemMgr. Implement SpurMemMgr>>isClassOfNonImm:equalTo:. =============== Diff against VMMaker.oscog-eem.392 =============== Item was added: + ----- Method: NewObjectMemory>>eeInstantiateSmallClass:numSlots: (in category 'interpreter access') ----- + eeInstantiateSmallClass: classPointer numSlots: numSlots + "This version of instantiateClass assumes that the total object + size is under 256 bytes, the limit for objects with only one or + two header words. + NOTE this code will only work for sizes that are an integral number of words + (like not a 32-bit LargeInteger in a 64-bit system). + Will *not* cause a GC. + Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak. + Since this call is used in routines that do just that we are safe. Break this rule and die." + + | sizeInBytes hash header1 header2 hdrSize | + sizeInBytes := numSlots << ShiftForWord + BaseHeaderSize. + self assert: sizeInBytes <= 252. + hash := self newObjectHash. + header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: (self formatOfClass: classPointer). + header2 := classPointer. + hdrSize := (header1 bitAnd: CompactClassMask) > 0 "is this a compact class" + ifTrue: [1] + ifFalse: [2]. + header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask+Size4Bit)). + ^self eeAllocate: sizeInBytes headerSize: hdrSize h1: header1 h2: header2 h3: 0! Item was removed: - ----- Method: NewObjectMemory>>eeInstantiateSmallClass:sizeInBytes: (in category 'interpreter access') ----- - eeInstantiateSmallClass: classPointer sizeInBytes: sizeInBytes - "This version of instantiateClass assumes that the total object - size is under 256 bytes, the limit for objects with only one or - two header words. Note that the size is specified in bytes - and should include 4 or 8 bytes for the base header word. - NOTE this code will only work for sizes that are an integral number of words - (like not a 32-bit LargeInteger in a 64-bit system). - Will *not* cause a GC. - Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak. - Since this call is used in routines that do just that we are safe. Break this rule and die." - - | hash header1 header2 hdrSize | - "size must be integral number of words" - self assert: (sizeInBytes bitAnd: (BytesPerWord-1)) = 0. - hash := self newObjectHash. - header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: (self formatOfClass: classPointer). - header2 := classPointer. - hdrSize := (header1 bitAnd: CompactClassMask) > 0 "is this a compact class" - ifTrue: [1] - ifFalse: [2]. - header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask+Size4Bit)). - ^self eeAllocate: sizeInBytes headerSize: hdrSize h1: header1 h2: header2 h3: 0! Item was added: + ----- Method: SpurMemoryManager>>eeInstantiateSmallClass:numSlots: (in category 'allocation') ----- + eeInstantiateSmallClass: classObj numSlots: numSlots + | classIndex | + <inline: true> + classIndex := self ensureBehaviorHash: classObj. + ^self + eeInstantiateClassIndex: classIndex + format: (self instSpecOfClass: classObj) + numSlots: numSlots! Item was changed: ----- Method: SpurMemoryManager>>isClassOfNonImm:equalTo: (in category 'object testing') ----- isClassOfNonImm: objOop equalTo: classOop + ^(self classIndexOf: objOop) = (self rawHashBitsOf: classOop)! - self shouldBeImplemented! Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop "This list records the valid senders of isIntegerObject: as we replace uses of isIntegerObject: by isImmediate: where appropriate." (#( DoIt DoItIn: makeBaseFrameFor: quickFetchInteger:ofObject: frameOfMarriedContext: objCouldBeClassObj: isMarriedOrWidowedContext: shortPrint: bytecodePrimAt bytecodePrimAtPut commonAt: commonAtPut: loadFloatOrIntFrom: positive32BitValueOf: primitiveExternalCall checkedIntegerValueOf: bytecodePrimAtPut commonAtPut: primitiveVMParameter checkIsStillMarriedContext:currentFP: displayBitsOf:Left:Top:Right:Bottom: fetchStackPointerOf: primitiveContextAt primitiveContextAtPut subscript:with:storing:format: printContext: compare31or32Bits:equal: signed64BitValueOf: primDigitMultiply:negative: digitLength: isNegativeIntegerValueOf: + magnitude64BitValueOf: + primitiveMakePoint) includes: thisContext sender method selector) ifFalse: - magnitude64BitValueOf:) includes: thisContext sender method selector) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0! Item was added: + ----- Method: SpurMemoryManager>>splObj:put: (in category 'interpreter access') ----- + splObj: index put: anObject + "Set one of the objects in the SpecialObjectsArray" + self storePointer: index ofObject: specialObjectsOop withValue: anObject! Item was changed: ----- Method: StackInterpreter>>closureIn:numArgs:instructionPointer:copiedValues: (in category 'control primitives') ----- closureIn: context numArgs: numArgs instructionPointer: initialIP copiedValues: copiedValues | newClosure numCopied | <inline: true> "numCopied should be zero for nil" numCopied := objectMemory fetchWordLengthOf: copiedValues. ClassBlockClosureCompactIndex ~= 0 ifTrue: [newClosure := objectMemory eeInstantiateClassIndex: ClassBlockClosureCompactIndex format: objectMemory indexablePointersFormat numSlots: ClosureFirstCopiedValueIndex + numCopied] ifFalse: [newClosure := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure) + numSlots: ClosureFirstCopiedValueIndex + numCopied]. - sizeInBytes: (BytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + BaseHeaderSize]. "Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores." objectMemory storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context; storePointerUnchecked: ClosureStartPCIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: initialIP); storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs). 0 to: numCopied - 1 do: [:i| objectMemory storePointerUnchecked: i + ClosureFirstCopiedValueIndex ofObject: newClosure withValue: (objectMemory fetchPointer: i ofObject: copiedValues)]. ^newClosure! Item was changed: ----- Method: StackInterpreter>>closureIn:numArgs:instructionPointer:numCopiedValues: (in category 'control primitives') ----- closureIn: context numArgs: numArgs instructionPointer: initialIP numCopiedValues: numCopied | newClosure | <inline: true> ClassBlockClosureCompactIndex ~= 0 ifTrue: [newClosure := objectMemory eeInstantiateClassIndex: ClassBlockClosureCompactIndex format: objectMemory indexablePointersFormat numSlots: ClosureFirstCopiedValueIndex + numCopied] ifFalse: + [newClosure := objectMemory - [self assert: (BytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + BaseHeaderSize <= 252. - newClosure := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure) + numSlots: ClosureFirstCopiedValueIndex + numCopied]. - sizeInBytes: (BytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + BaseHeaderSize]. "Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores." objectMemory storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context. objectMemory storePointerUnchecked: ClosureStartPCIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: initialIP). objectMemory storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs). ^newClosure! Item was changed: ----- Method: StackInterpreter>>makePointwithxValue:yValue: (in category 'utilities') ----- makePointwithxValue: xValue yValue: yValue + "make a Point xValue@yValue. + We know both will be integers so no value nor root checking is needed" - "make a Point xValue@yValue. - We know both will be integers so no value nor root checking is needed" | pointResult | + pointResult := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassPoint) numSlots: YIndex + 1. - pointResult := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassPoint) sizeInBytes: 3*BytesPerWord. objectMemory storePointerUnchecked: XIndex ofObject: pointResult withValue: (objectMemory integerObjectOf: xValue). objectMemory storePointerUnchecked: YIndex ofObject: pointResult withValue: (objectMemory integerObjectOf: yValue). + ^pointResult! - ^ pointResult!

1 0

VM Maker: Cog-eem.92.mcz
by commits＠source.squeak.org 19 Sep '13

19 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.92.mcz ==================== Summary ==================== Name: Cog-eem.92 Author: eem Time: 19 September 2013, 1:22:23.662 pm UUID: 03144fa4-dcb6-46ce-9d5b-05ed9cdbd3b8 Ancestors: Cog-eem.91 SpurBootstrap: Rename symbolMap to literalMap and abstract away from direct access to Smalltalk object's internals, instead simulating bindingOf:, hence allowing bootstrap of Squeak trunk image that uses Environments. =============== Diff against Cog-eem.91 =============== Item was changed: Object subclass: #SpurBootstrap + instanceVariableNames: 'oldHeap newHeap map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes sizeSym rehashSym' - instanceVariableNames: 'oldHeap newHeap map reverseMap classToIndex oldInterpreter lastClassTablePage symbolMap methodClasses installedPrototypes sizeSym rehashSym' classVariableNames: 'NewInterpreter TransformedImage' poolDictionaries: 'VMObjectIndices' category: 'Cog-Bootstrapping'! !SpurBootstrap commentStamp: 'eem 9/11/2013 05:45' prior: 0! SpurBootstrap bootstraps an image in SpurMemoryManager format from a Squeak V3 + closures format. e.g. (SpurBootstrap32 new on: '/Users/eliot/Cog/startreader.image') transform; launch Bootstrap issues: - should it implement a deterministic Symbol identityHash? This means set a Symbol's identityHash at instance creation time based on its string hash so that e.g. MethodDIctionary instances have a deterministic order and don't need to be rehashed on load. - should it collapse ContextPart and MethodContext down onto Context (and perhaps eliminate BlockContext)? Instance Variables classToIndex: <Dictionary> lastClassTablePage: <Integer> map: <Dictionary> methodClasses: <Set> newHeap: <SpurMemoryManager> oldHeap: <NewObjectMemory> oldInterpreter: <StackInterpreterSimulator> reverseMap: <Dictionary> symbolMap: <Dictionary> classToIndex - oldClass to new classIndex map lastClassTablePage - oop in newHeap of last classTable page. U<sed in validation to filter-out class table. methodClasses - cache of methodClassAssociations for classes in which modified methods are installed map - oldObject to newObject map newHeap - the output, bootstrapped image oldHeap - the input, image oldInterpreter - the interpreter associated with oldHeap, needed for a hack to grab WeakArray reverseMap - newObject to oldObject map symbolMap - symbol toi symbol oop in oldHeap, used to map prototype methdos to methods in oldHeap! Item was changed: ----- Method: SpurBootstrap>>addNewMethods (in category 'bootstrap methods') ----- addNewMethods "Get the simulator to add any and all missing methods immediately." | cmaiaSym basSym | cmaiaSym := self findSymbol: #compiledMethodAt:ifAbsent:. basSym := self findSymbol: #basicAddSelector:withMethod:. basSym ifNil: [basSym := self findSymbol: #addSelectorSilently:withMethod:]. self allPrototypeClassNamesDo: [:sym :symIsMeta| | class | + class := self findClassNamed: (literalMap at: sym). - class := self findClassNamed: (symbolMap at: sym). symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class]. self prototypeClassNameMetaSelectorMethodDo: [:className :isMeta :selector :method| | methodOrNil | (className = sym and: [symIsMeta = isMeta]) ifTrue: ["probe method dictionary of the class for each method, installing a dummy if not found." "Transcript cr; nextPutAll: 'checking for '; nextPutAll: selector; flush." methodOrNil := self interpreter: oldInterpreter object: class perform: cmaiaSym + withArguments: {literalMap at: selector. oldHeap nilObject}. - withArguments: {symbolMap at: selector. oldHeap nilObject}. methodOrNil = oldHeap nilObject ifTrue: "no method. install the real thing now" [Transcript cr; nextPutAll: 'installing '; nextPutAll: className; nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']); store: selector; flush. self interpreter: oldInterpreter object: class perform: basSym + withArguments: { literalMap at: selector. - withArguments: { symbolMap at: selector. self installableMethodFor: method selector: selector className: className isMeta: isMeta}. installedPrototypes add: method selector] ifFalse: "existing method; collect the methodClassAssociation; its needed later" [methodClasses add: (oldInterpreter methodClassAssociationOf: methodOrNil)]]]]! Item was changed: ----- Method: SpurBootstrap>>defineKnownClassIndices (in category 'class indices') ----- defineKnownClassIndices "The classTable is laid out - to make it easy to map immediates to classes; the tag pattern of an immediate is its class index. hence there are two entries for SmallInteger - to assign small indices to well-known classes such as Array, Message et al - to leave plenty of room for new known classes; hence the first page contains only well-known classes - to enable overlaps and avoid conflicts with indices in the specialObjectsArray (?really? eem) - to provide a WeakArray pun for the pages of the table itself so that these do not show up as instances of WeakArray" | classMethodContext classBlockClosure classMessage "no api method for these" | classMessage := oldHeap splObj: (VMObjectIndices bindingOf: #ClassMessage) value. classMethodContext := oldHeap splObj: (VMObjectIndices bindingOf: #ClassMethodContext) value. classBlockClosure := oldHeap splObj: (VMObjectIndices bindingOf: #ClassBlockClosure) value. "c.f. SpurMemoryManager class>>intializeCompactClassIndices". classToIndex keysDo: [:oldClass| self assert: (oldInterpreter addressCouldBeClassObj: oldClass)]. classToIndex at: oldHeap classSmallInteger put: 1; "N.B. must fill-in index 3 manually" at: oldHeap classCharacter put: 2; "at: oldHeap classSmallInteger put: 3" "N.B. must fill-in index 3 manually" "leave room for up to 15 tagged classes" "leave room for up to 16 puns" at: oldHeap classLargeNegativeInteger put: 32; at: oldHeap classLargePositiveInteger put: 33; at: oldHeap classFloat put: 34; at: "oldHeap" classMessage put: 35; at: "oldHeap" classMethodContext put: 36; at: "oldHeap" classBlockClosure put: 37; at: oldHeap classSemaphore put: 48; + "at: oldHeap classMutex put: 49; see below" - at: oldHeap classMutex put: 49; at: oldHeap classByteArray put: 50; at: oldHeap classArray put: 51; at: oldHeap classString put: 52; at: oldHeap classBitmap put: 53; + at: oldHeap classPoint put: 54. - at: oldHeap classPoint put: 54; + {{oldHeap classMutex. 49}. + {oldHeap classExternalAddress. 128}. + {oldHeap classExternalData. 129}. + {oldHeap classExternalFunction. 130}. + {oldHeap classExternalLibrary. 131}. + {oldHeap classExternalStructure. 132}. + {oldHeap classAlien. 133}. + {oldHeap classUnsafeAlien. 134}} + do: [:pair| + [:oop :index| + oop ~= oldHeap nilObject ifTrue: + [classToIndex at: oop put: index]] valueWithArguments: pair]. + - at: oldHeap classExternalAddress put: 128; - at: oldHeap classExternalData put: 129; - at: oldHeap classExternalFunction put: 130; - at: oldHeap classExternalLibrary put: 131; - at: oldHeap classExternalStructure put: 132; - at: oldHeap classAlien put: 133; - at: oldHeap classUnsafeAlien put: 134. classToIndex keysDo: [:oldClass| self assert: (oldInterpreter addressCouldBeClassObj: oldClass)]! Item was added: + ----- Method: SpurBootstrap>>findRequiredGlobals (in category 'bootstrap methods') ----- + findRequiredGlobals + "Look for the necessary gobal bindings in the prototype methods in the old image. + This has to be done early by sending bindingOf: to Smalltalk." + | globals bindingOf | + globals := Set new. + self prototypeClassNameMetaSelectorMethodDo: + [:c :m :s :method| + globals addAll: (method literals select: [:l| + l isVariableBinding + and: [l key isSymbol + and: [(Smalltalk bindingOf: l key) == l]]])]. + bindingOf := self findSymbol: #bindingOf:. + self withExecutableInterpreter: oldInterpreter + do: [globals do: + [:global| + literalMap + at: global + put: (self interpreter: oldInterpreter + object: (oldHeap splObj: 8) "Smalltalk" + perform: bindingOf + withArguments: {self findSymbol: global key})]]! Item was changed: ----- Method: SpurBootstrap>>installModifiedMethods (in category 'bootstrap methods') ----- installModifiedMethods "Install all the methods in the class-side method prototypes protocol in the relevant classes in the new image. First use the simulator to get the image to intern all symbols and add dummy methods under new selectors. With that done we can manually replace the relevant methods with the prototypes, mapping selectors and global variables as required." - symbolMap := Dictionary new. - methodClasses := Set new. - installedPrototypes := Set new. self withExecutableInterpreter: oldInterpreter do: [self internAllSymbols. self addNewMethods. self replaceMethods. self modifyCharacterMethods]! Item was changed: ----- Method: SpurBootstrap>>installableMethodFor:selector:className:isMeta: (in category 'bootstrap methods') ----- installableMethodFor: aCompiledMethod selector: selector className: className isMeta: isMeta | compiledMethodClass sourcelessMethod bytes newMethod methodClass | compiledMethodClass := self findClassNamed: (self findSymbol: #CompiledMethod). "the prototypes hve source pointers. the Character methods to be replaced don't." sourcelessMethod := aCompiledMethod trailer hasSourcePointer ifTrue: [aCompiledMethod copyWithTempsFromMethodNode: aCompiledMethod methodNode] ifFalse: [aCompiledMethod]. bytes := sourcelessMethod size - sourcelessMethod initialPC + 1. newMethod := self interpreter: oldInterpreter object: compiledMethodClass perform: (self findSymbol: #newMethod:header:) withArguments: { oldHeap integerObjectOf: bytes. oldHeap integerObjectOf: sourcelessMethod header }. 1 to: sourcelessMethod numLiterals - 1 do: [:i| | literal oop | literal := sourcelessMethod literalAt: i. literal isMethodProperties ifTrue: [literal := selector]. oop := (literal isLiteral or: [literal isVariableBinding]) ifTrue: [literal isInteger ifTrue: [oldHeap integerObjectOf: literal] + ifFalse: [literalMap at: literal ifAbsent: [self findLiteral: literal]]] - ifFalse: [symbolMap at: literal ifAbsent: [self findLiteral: literal]]] ifFalse: "should be a VMObjectProxy" [literal oop]. oldHeap storePointer: i ofObject: newMethod withValue: oop]. methodClass := self methodClassForClassName: className isMeta: isMeta. oldHeap storePointer: sourcelessMethod numLiterals ofObject: newMethod withValue: methodClass. sourcelessMethod initialPC to: sourcelessMethod size do: [:i| oldHeap storeByte: i - 1 ofObject: newMethod withValue: (sourcelessMethod byteAt: i)]. ^newMethod! Item was changed: ----- Method: SpurBootstrap>>internAllSymbols (in category 'bootstrap methods') ----- internAllSymbols "Ensure that all symbols in the method prototypes are interned so that later we can install them. Enter them into the map, this system's symbol -> oldHeap's version. Do this by interpreting Symbol intern: 'aSymbol' for each symbol." | internSym | internSym := self findSymbol: #intern:. self allPrototypeMethodSymbols do: [:sym| (self findSymbol: sym) + ifNotNil: [:imageSym| literalMap at: sym put: imageSym] - ifNotNil: [:imageSym| symbolMap at: sym put: imageSym] ifNil:[Transcript cr; nextPutAll: 'interning '; nextPutAll: sym; flush. "Interpret Symbol intern: sym to ... intern it :-)" + literalMap - symbolMap at: sym put: (self interpreter: oldInterpreter object: self symbolClass perform: internSym withArguments: {self stringFor: sym})]]. + literalMap keysAndValuesDo: + [:symOrGlobal :imageSymOrGlobal| + symOrGlobal isSymbol ifTrue: + [self assert: symOrGlobal = (oldHeap stringOf: imageSymOrGlobal)]]! - symbolMap keysAndValuesDo: - [:sym :imageSym| - self assert: sym = (oldHeap stringOf: imageSym)]! Item was changed: ----- Method: SpurBootstrap>>methodClassForClassName:isMeta: (in category 'bootstrap methods') ----- methodClassForClassName: classNameSymbol isMeta: isMeta | class | + class := self findClassNamed: (literalMap at: classNameSymbol). - class := self findClassNamed: (symbolMap at: classNameSymbol). isMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class]. methodClasses do: [:mca| class = (oldHeap fetchPointer: ValueIndex ofObject: mca) ifTrue: [^mca]]. oldHeap allObjectsDo: [:o| | methodClassAssociation | (oldHeap isCompiledMethod: o) ifTrue: [methodClassAssociation := oldInterpreter methodClassAssociationOf: o. class == (oldHeap fetchPointer: ValueIndex ofObject: methodClassAssociation) ifTrue: [methodClasses add: methodClassAssociation. ^methodClassAssociation]]]. self error: 'could not find methodClassAssociation for ', classNameSymbol, (isMeta ifTrue: [' class'] ifFalse:[''])! Item was changed: ----- Method: SpurBootstrap>>on: (in category 'initialize-release') ----- on: imageName StackInterpreter initializeWithOptions: Dictionary new. oldInterpreter := StackInterpreterSimulator new. oldInterpreter openOn: imageName extraMemory: 0. oldHeap := oldInterpreter objectMemory. newHeap := Spur32BitMMLESimulator new. newHeap allocateMemoryOfSize: (oldHeap youngStart * 5 / 4 roundUpTo: 8) newSpaceSize: 1024 * 1024 codeSize: 1024 * 1024. newHeap setCheckForLeaks: 15 - 4. "don't check become" map := Dictionary new: oldHeap memory size // 4. reverseMap := Dictionary new: oldHeap memory size // 4. + classToIndex := Dictionary new: 1024. + literalMap := IdentityDictionary new. + methodClasses := Set new. + installedPrototypes := Set new! - classToIndex := Dictionary new: 1024! Item was changed: ----- Method: SpurBootstrap>>replaceMethods (in category 'bootstrap methods') ----- replaceMethods "Replace all the modified method prototypes." self allPrototypeClassNamesDo: [:sym :symIsMeta| | class | + class := self findClassNamed: (literalMap at: sym). - class := self findClassNamed: (symbolMap at: sym). symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class]. self prototypeClassNameMetaSelectorMethodDo: [:className :isMeta :selector :method| | replacement methodDict index | (className = sym and: [symIsMeta = isMeta]) ifTrue: [(installedPrototypes includes: method selector) ifFalse: ["probe method dictionary of the class for each method, installing a dummy if not found." Transcript cr; nextPutAll: 'replacing '; nextPutAll: className; nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']); store: selector; flush. replacement := self installableMethodFor: method selector: selector className: className isMeta: isMeta. methodDict := oldHeap fetchPointer: MethodDictionaryIndex ofObject: class. + index := self indexOfSelector: (literalMap at: selector) in: methodDict. - index := self indexOfSelector: (symbolMap at: selector) in: methodDict. oldHeap storePointer: index - SelectorStart ofObject: (oldHeap fetchPointer: MethodArrayIndex ofObject: methodDict) withValue: replacement. installedPrototypes add: method selector]]]]! Item was changed: ----- Method: SpurBootstrap>>replacementForCharacterMethod: (in category 'bootstrap methods') ----- replacementForCharacterMethod: characterMethodOop "Answer a replacement method for the argument if it refers to Character's old inst var value. Otherwise answer nil." | proxy asIntegerProxy clone assembly newInsts newMethod | "(oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue: [self halt]." proxy := VMCompiledMethodProxy new for: characterMethodOop coInterpreter: oldInterpreter objectMemory: oldHeap. clone := self cloneMethodProxy: proxy. "Quick methods accessing value should have been replaced." clone isReturnField ifTrue: [self halt]. clone hasInstVarRef ifFalse: [^nil]. clone setSourcePointer: 0. asIntegerProxy := VMObjectProxy new + for: (literalMap at: #asInteger) - for: (symbolMap at: #asInteger) coInterpreter: oldInterpreter objectMemory: oldHeap. assembly := BytecodeDisassembler new disassemble: clone. assembly literals: (assembly literals allButLast: 2), {asIntegerProxy}, (assembly literals last: 2). "Do this by looking for index of pushReceiverVariable: and replacing it by pushSelf, send asInteger" newInsts := (assembly instructions piecesCutWhere: [:msgOrLabelAssoc :nextInst| msgOrLabelAssoc isVariableBinding not and: [msgOrLabelAssoc selector == #pushReceiverVariable:]]) fold: [:a :b| a allButLast, { Message selector: #pushReceiver. Message selector: #send:super:numArgs: arguments: {asIntegerProxy. false. 0}}, b]. assembly instructions: newInsts. newMethod := assembly assemble. ^self installableMethodFor: newMethod selector: clone selector className: #Character isMeta: false! Item was changed: ----- Method: SpurBootstrap>>transform (in category 'bootstrap image') ----- transform self rememberRehashSymbol. + self findRequiredGlobals. self installModifiedMethods. self bootstrapImage. self validate. self rehashImage. self followForwardingPointers. self scavengeImage. Transcript nextPutAll: 'done.'; flush.!

1 0

VM Maker: VMMaker.oscog-eem.392.mcz
by commits＠source.squeak.org 19 Sep '13

19 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.392.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.392 Author: eem Time: 19 September 2013, 1:16:32.803 pm UUID: b795dbfe-8802-4301-96d4-ce2e941b740d Ancestors: VMMaker.oscog-eem.391 Abstract remapOop:in: away fom specific GC types (Spur will have three) and add ObjectMemory/SpurMemMgr>>statNumGCs to sum them. Nuke initFreeChunkWithSlots:at: and use freeChunkWithBytes:at: in init. Also type it correctly (allow > 31 bit sizes). followForwarded: needs to cope with immediate targets given 1-way become. Fix slip in innerBecomeObjectsIn:to:copyHash:. Refactor SpurMemMgr>>lengthOf:baseHeader:format: to lengthOf:format: Add more protocol to SpurMemMgr (due to simulating a bootstrapping squeak image). StackInterpreter>>stackObjectValue: uses isImmediate: =============== Diff against VMMaker.oscog-eem.391 =============== Item was added: + ----- Method: ObjectMemory>>statNumGCs (in category 'accessing') ----- + statNumGCs + ^statIncrGCs + statFullGCs! Item was changed: ----- Method: SmartSyntaxInterpreterPlugin>>remapOop:in: (in category 'simulation') ----- remapOop: oopOrList in: aBlock <doNotGenerate> + | numGCs result | + numGCs := interpreterProxy statNumGCs. - | numIncrGCs numFullGCs result | - numIncrGCs := interpreterProxy statIncrGCs. - numFullGCs := interpreterProxy statFullGCs. result := aBlock value. "If you really did want to implement remapping you would try and locate the arguments in the caller context and update them via tempAt:put:. But beware ambiguities. You'd have to parse the bytecode to be sure to get the right temps." + numGCs ~= interpreterProxy statNumGCs ifTrue: - (numIncrGCs ~= interpreterProxy statIncrGCs - or: [numFullGCs ~= interpreterProxy statFullGCs]) ifTrue: [self error: 'GC occurred in middle of remapOop:in: and remapping in this context is not implemented']. ^result! Item was added: + ----- Method: Spur32BitMMLESimulator>>booleanValueOf: (in category 'C library simulation') ----- + booleanValueOf: obj + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter booleanValueOf: obj! Item was added: + ----- Method: Spur32BitMMLESimulator>>cCoerce:to: (in category 'memory access') ----- + cCoerce: value to: cTypeString + "Type coercion. For translation a cast will be emmitted. When running in Smalltalk + answer a suitable wrapper for correct indexing." + + ^value + ifNil: [value] + ifNotNil: [value coerceTo: cTypeString sim: self]! Item was added: + ----- Method: Spur32BitMMLESimulator>>failed (in category 'simulation only') ----- + failed + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter failed! Item was added: + ----- Method: Spur32BitMMLESimulator>>firstIndexableField: (in category 'object format') ----- + firstIndexableField: objOop + "NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes. + There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5. + The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end + of the object). For 3 we must go to the class." + | fmt classFormat | + <returnTypeC: #'void *'> + fmt := self formatOf: objOop. + fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word" + [fmt = self indexablePointersFormat ifTrue: + [classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop). + ^self cCoerce: (self pointerForOop: objOop + + self baseHeaderSize + + ((self fixedFieldsOfClassFormat: classFormat) << self wordSize)) + to: #'oop *']. + ^self cCoerce: (self pointerForOop: objOop + + self baseHeaderSize + + ((self numSlotsOf: objOop) << self wordSize)) + to: #'oop *']. + "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0" + self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]). + ^self + cCoerce: (self pointerForOop: objOop + self baseHeaderSize) + to: (fmt < self firstByteFormat + ifTrue: + [fmt = self sixtyFourBitIndexableFormat + ifTrue: ["64 bit field objects" #'long long *'] + ifFalse: + [fmt < self firstShortFormat + ifTrue: ["32 bit field objects" #'int *'] + ifFalse: ["16-bit field objects" #'short *']]] + ifFalse: ["byte objects (including CompiledMethod" #'char *'])! Item was added: + ----- Method: Spur32BitMMLESimulator>>is:KindOf: (in category 'simulation only') ----- + is: oop KindOf: classNameString + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter is: oop KindOf: classNameString! Item was added: + ----- Method: Spur32BitMMLESimulator>>methodArgumentCount (in category 'simulation only') ----- + methodArgumentCount + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter methodArgumentCount! Item was added: + ----- Method: Spur32BitMMLESimulator>>pop:thenPush: (in category 'simulation only') ----- + pop: nItems thenPush: oop + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter pop: nItems thenPush: oop! Item was added: + ----- Method: Spur32BitMMLESimulator>>stackValue: (in category 'simulation only') ----- + stackValue: offset + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter stackValue: offset! Item was added: + ----- Method: Spur32BitMMLESimulator>>success: (in category 'simulation only') ----- + success: boolean + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter success: boolean! Item was changed: ----- Method: Spur32BitMemoryManager>>bytesInObject: (in category 'object enumeration') ----- bytesInObject: objOop "Answer the total number of bytes in an object including header and possible overflow size header." + <returnTypeC: #usqLong> | halfHeader headerNumSlots numSlots | self flag: #endianness. halfHeader := self longAt: objOop + 4. headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask. numSlots := headerNumSlots = self numSlotsMask ifTrue: [self longAt: objOop - self baseHeaderSize] ifFalse: [headerNumSlots = 0 ifTrue: [1] ifFalse: [headerNumSlots]]. ^numSlots + (numSlots bitAnd: 1) << self shiftForWord + (headerNumSlots = self numSlotsMask ifTrue: [self baseHeaderSize + self baseHeaderSize] ifFalse: [self baseHeaderSize])! Item was added: + ----- Method: Spur32BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') ----- + initFreeChunkWithBytes: numBytes at: address + <var: #numBytes type: #usqLong> + | numSlots | + "must have room for a header (single or double) plus the next free pointer" + self assert: (numBytes \\ self allocationUnit = 0 + and: [numBytes >= (self baseHeaderSize + self wordSize)]). + self flag: #endianness. + "double header" + numBytes >= (self numSlotsMask << self shiftForWord) ifTrue: + [numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord. + self longAt: address put: numSlots; + longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift; + longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks" + longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift. + ^address + 8]. + "single header" + numSlots := numBytes - self baseHeaderSize >> self shiftForWord. + self longAt: address put: 0; "0's classIndex; 0 = classIndex of free chunks" + longAt: address + 4 put: numSlots << self numSlotsHalfShift. + ^address! Item was removed: - ----- Method: Spur32BitMemoryManager>>initFreeChunkWithSlots:at: (in category 'garbage collection') ----- - initFreeChunkWithSlots: numSlots at: address - self flag: #endianness. - self longAt: address put: numSlots; - longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift; - longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks" - longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift. - ^address + 8! Item was added: + ----- Method: Spur64BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'garbage collection') ----- + initFreeChunkWithBytes: numBytes at: address + <var: #numBytes type: #usqLong> + | numSlots | + "must have room for a header (single or double) plus the next free pointer" + self assert: (numBytes \\ self allocationUnit = 0 + and: [numBytes >= (self baseHeaderSize + self wordSize)]). + self flag: #endianness. + "double header" + numBytes >= (self numSlotsMask << self shiftForWord) ifTrue: + [numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord. + self longLongAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots; + longLongAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" + ^address + 8]. + "single header" + numSlots := numBytes - self baseHeaderSize >> self shiftForWord. + self longLongAt: address put: numSlots << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" + ^address! Item was removed: - ----- Method: Spur64BitMemoryManager>>initFreeChunkWithSlots:at: (in category 'garbage collection') ----- - initFreeChunkWithSlots: numSlots at: address - self flag: #endianness. - self longAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots; - longAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks" - ^address + 8! Item was changed: CogClass subclass: #SpurMemoryManager (excessive size, no diff calculated) Item was added: + ----- Method: SpurMemoryManager>>classLargeNegativeInteger (in category 'plugin support') ----- + classLargeNegativeInteger + ^self knownClassAtIndex: ClassLargeNegativeIntegerCompactIndex! Item was added: + ----- Method: SpurMemoryManager>>classLargePositiveInteger (in category 'plugin support') ----- + classLargePositiveInteger + ^self knownClassAtIndex: ClassLargePositiveIntegerCompactIndex! Item was added: + ----- Method: SpurMemoryManager>>firstIndexableField: (in category 'object format') ----- + firstIndexableField: objOop + "NOTE: overridden in various simulator subclasses to add coercion to CArray, so please duplicate any changes. + There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5. + The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end + of the object). For 3 we must go to the class." + | fmt classFormat | + <returnTypeC: #'void *'> + fmt := self formatOf: objOop. + fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word" + [fmt = self indexablePointersFormat ifTrue: + [classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop). + ^self pointerForOop: objOop + + self baseHeaderSize + + ((self fixedFieldsOfClassFormat: classFormat) << self wordSize)]. + ^self pointerForOop: objOop + + self baseHeaderSize + + ((self numSlotsOf: objOop) << self wordSize)]. + "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0" + self assert: fmt < self firstCompiledMethodFormat. + ^self pointerForOop: objOop + self baseHeaderSize! Item was changed: ----- Method: SpurMemoryManager>>followForwarded: (in category 'become api') ----- followForwarded: objOop "Follow a forwarding pointer. Alas we cannot prevent forwarders to forwarders + being created by lazy become. Consider the following example by Igor Stasenko: - being created by lazy become. Consider the following example by Igor Stasenk: array := { a. b. c }. - array at: 1 points to &a. array at: 2 points to &b. array at: 3 points to &c Ó a becomeForward: b - array at: 1 still points to &a. array at: 2 still points to &b. array at: 3 still points to &c b becomeForward: c. - array at: 1 still points to &a. array at: 2 still points to &b. array at: 3 still points to &c - when accessing array first one has to follow a forwarding chain: &a -> &b -> c" | referent | self assert: (self isForwarded: objOop). referent := self fetchPointer: 0 ofMaybeForwardedObject: objOop. + [(self isOopForwarded: referent)] whileTrue: - [(self isForwarded: referent)] whileTrue: [referent := self fetchPointer: 0 ofMaybeForwardedObject: referent]. ^referent! Item was changed: ----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') ----- freeChunkWithBytes: bytes at: address <inline: true> | freeChunk | freeChunk := self initFreeChunkWithBytes: bytes at: address. + self addToFreeList: freeChunk. + ^freeChunk! - self addToFreeList: freeChunk.! Item was changed: ----- Method: SpurMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') ----- initFreeChunkWithBytes: numBytes at: address + <var: #numBytes type: #usqLong> + ^self subclassResponsibility! - | numSlots | - self assert: numBytes \\ self allocationUnit = 0. - numSlots := numBytes >> self shiftForWord - - (numBytes >= (self numSlotsMask << self shiftForWord) - ifTrue: [self baseHeaderSize + self baseHeaderSize / self wordSize] - ifFalse: [self baseHeaderSize / self wordSize]). - ^self initFreeChunkWithSlots: numSlots at: address! Item was removed: - ----- Method: SpurMemoryManager>>initFreeChunkWithSlots:at: (in category 'free space') ----- - initFreeChunkWithSlots: numSlots at: address - ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>initialize (in category 'initialization') ----- initialize freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0). freeListsMask := 0. checkForLeaks := 0. needGCFlag := signalLowSpace := scavengeInProgress := false. becomeEffectsFlags := 0. heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]. + statScavenges := statIncrGCs := statFullGCs := 0. - statScavenges := 0. statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := 0. statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0! Item was changed: ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') ----- initializeOldSpaceFirstFree: startOfFreeOldSpace <var: 'startOfFreeOldSpace' type: #usqLong> | freeOldStart freeChunk | <var: 'freeOldStart' type: #usqLong> - 0 to: NumFreeLists - 1 do: - [:i| freeLists at: i put: 0]. freeOldStart := startOfFreeOldSpace. [endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue: + [freeChunk := self freeChunkWithBytes: (2 raisedTo: 32) at: freeOldStart. + freeOldStart := freeOldStart + (2 raisedTo: 32). + self assert: freeOldStart = (self addressAfter: freeChunk)]. + freeOldStart < endOfMemory ifTrue: + [freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. + self assert: (self addressAfter: freeChunk) = endOfMemory]. - [freeChunk := self initFreeChunkWithSlots: (2 raisedTo: 32) / self wordSize at: freeOldStart. - self addToFreeList: freeChunk. - freeOldStart := self addressAfter: freeChunk]. - freeChunk := self initFreeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. - self addToFreeList: freeChunk. - self assert: (self addressAfter: freeChunk) = endOfMemory. freeOldSpaceStart := endOfMemory! Item was changed: ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:to:copyHash: (in category 'become implementation') ----- innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag "Inner loop of one-way become." 0 to: (self numSlotsOf: array1) - 1 do: [:i| | obj1 obj2 | obj1 := self fetchPointer: i ofObject: array1. obj2 := self fetchPointer: i ofObject: array2. + self doBecome: obj1 to: obj2 copyHash: copyHashFlag. - self doBecome: obj1 with: obj2 copyHash: copyHashFlag. (self isForwarded: obj1) ifTrue: [obj1 := self followForwarded: obj1. self storePointer: i ofObject: array1 withValue: obj1]. self assert: (self isForwarded: obj2) not]! Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop "This list records the valid senders of isIntegerObject: as we replace uses of isIntegerObject: by isImmediate: where appropriate." (#( DoIt DoItIn: makeBaseFrameFor: quickFetchInteger:ofObject: frameOfMarriedContext: objCouldBeClassObj: isMarriedOrWidowedContext: shortPrint: bytecodePrimAt bytecodePrimAtPut commonAt: commonAtPut: loadFloatOrIntFrom: positive32BitValueOf: primitiveExternalCall checkedIntegerValueOf: bytecodePrimAtPut commonAtPut: primitiveVMParameter checkIsStillMarriedContext:currentFP: displayBitsOf:Left:Top:Right:Bottom: fetchStackPointerOf: primitiveContextAt primitiveContextAtPut subscript:with:storing:format: printContext: compare31or32Bits:equal: + signed64BitValueOf: + primDigitMultiply:negative: + digitLength: + isNegativeIntegerValueOf: + magnitude64BitValueOf:) includes: thisContext sender method selector) ifFalse: - signed64BitValueOf:) includes: thisContext sender method selector) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0! Item was changed: ----- Method: SpurMemoryManager>>lengthOf: (in category 'object access') ----- lengthOf: objOop + "Answer the number of indexable units in the given object. + For a CompiledMethod, the size of the method header (in bytes) should + be subtracted from the result." - "Answer the number of indexable bytes or words in the given object. - For a CompiledMethod, the size of the method header (in bytes) should be subtracted from the result." <api> - | header | - <var: #header type: #usqLong> <inline: true> + <asmLabel: false> + ^self lengthOf: objOop format: (self formatOf: objOop)! - <asmLabel: false> - header := self baseHeader: objOop. - ^self lengthOf: objOop baseHeader: header format: (self formatOfHeader: header)! Item was changed: ----- Method: SpurMemoryManager>>lengthOf:baseHeader:format: (in category 'object access') ----- lengthOf: objOop baseHeader: header format: fmt <var: #header type: #usqLong> "Compatibility; does not really suit the Spur format. Answer the number of indexable bytes or words in the given object. For a CompiledMethod, the size of the method header (in bytes) should be subtracted from the result of this method." + ^self lengthOf: objOop format: fmt! - | numSlots | - <inline: true> - <asmLabel: false> - numSlots := self numSlotsOf: objOop. - fmt <= self sixtyFourBitIndexableFormat ifTrue: - [^numSlots]. - fmt >= self firstByteFormat ifTrue: "bytes, including CompiledMethod" - [^numSlots << self shiftForWord - (fmt bitAnd: 7)]. - fmt >= self firstShortFormat ifTrue: - [^numSlots << (self shiftForWord - 1) - (fmt bitAnd: 3)]. - "fmt >= self firstLongFormat" - ^numSlots << (self shiftForWord - 2) - (fmt bitAnd: 1)! Item was added: + ----- Method: SpurMemoryManager>>lengthOf:format: (in category 'object access') ----- + lengthOf: objOop format: fmt + "Answer the number of indexable units in the given object. + For a CompiledMethod, the size of the method header (in bytes) + should be subtracted from the result of this method." + | numSlots | + <inline: true> + <asmLabel: false> + numSlots := self numSlotsOf: objOop. + fmt <= self sixtyFourBitIndexableFormat ifTrue: + [^numSlots]. + fmt >= self firstByteFormat ifTrue: "bytes, including CompiledMethod" + [^numSlots << self shiftForWord - (fmt bitAnd: 7)]. + fmt >= self firstShortFormat ifTrue: + [^numSlots << (self shiftForWord - 1) - (fmt bitAnd: 3)]. + "fmt >= self firstLongFormat" + ^numSlots << (self shiftForWord - 2) - (fmt bitAnd: 1)! Item was added: + ----- Method: SpurMemoryManager>>slotSizeOf: (in category 'object access') ----- + slotSizeOf: oop + "*DO NOT CONFUSE THIS WITH numSlotsOf:. + This is an ObjectMemory compatibility method with quesitonable semantics. + Answers the number of slots in the receiver. + If the receiver is a byte object, return the number of bytes. + Otherwise return the number of words." + (self isImmediate: oop) ifTrue: [^0]. + ^self lengthOf: oop! Item was added: + ----- Method: SpurMemoryManager>>statNumGCs (in category 'accessing') ----- + statNumGCs + ^statScavenges + statIncrGCs + statFullGCs! Item was changed: ----- Method: StackInterpreter>>stackObjectValue: (in category 'internal interpreter access') ----- stackObjectValue: offset "Ensures that the given object is a real object, not a SmallInteger." "In the StackInterpreter stacks grow down." | oop | oop := stackPages longAt: stackPointer + (offset * BytesPerWord). + (objectMemory isImmediate: oop) ifTrue: + [self primitiveFail. ^ nil]. + ^oop! - (objectMemory isIntegerObject: oop) ifTrue: [self primitiveFail. ^ nil]. - ^ oop - !

1 0

VM Maker: Cog-eem.91.mcz
by commits＠source.squeak.org 19 Sep '13

19 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.91.mcz ==================== Summary ==================== Name: Cog-eem.91 Author: eem Time: 18 September 2013, 6:21:37.61 pm UUID: b0e94ed6-219d-4e9a-8e04-ab08c6805eeb Ancestors: Cog-eem.90 Add a prototype for Character>>hash. Add checks for other quick methods. Get scavengeImage to completely flush newSpace at the end of the bootstrap. Follow forwarders before flushing new space. Bootstrasp now completes. =============== Diff against Cog-eem.90 =============== Item was added: + ----- Method: SpurBootstrap class>>CharacterPROTOTYPEhash (in category 'method prototypes') ----- + CharacterPROTOTYPEhash + <primitive: 171> + ^self primitiveFailed! Item was added: + ----- Method: SpurBootstrap>>followForwardingPointers (in category 'bootstrap image') ----- + followForwardingPointers + newHeap allObjectsDo: + [:o| + (newHeap isForwarded: o) ifFalse: + [0 to: (newHeap numPointerSlotsOf: o) - 1 do: + [:i| | field | + field := newHeap fetchPointer: i ofObject: o. + (newHeap isOopForwarded: field) ifTrue: + [newHeap + storePointer: i + ofObject: o + withValue: (newHeap followForwarded: field)]]]]! Item was changed: ----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') ----- rehashImage "Rehash all collections in newHeap. Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags. Enumerate all objects, rehashing those whose class has a bit set in rehashFlags." | n sim rehashFlags | sim := StackInterpreterSimulator onObjectMemory: newHeap. newHeap coInterpreter: sim. sim initializeInterpreter: 0. sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal. newHeap setHashBitsOf: newHeap nilObject to: 1; setHashBitsOf: newHeap falseObject to: 2; setHashBitsOf: newHeap trueObject to: 3. rehashFlags := ByteArray new: newHeap classTableIndex + 7 // 8. n := 0. newHeap classTableObjectsDo: [:class| | classIndex | sim messageSelector: (map at: rehashSym). "Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self." ((sim lookupMethodNoMNUEtcInClass: class) = 0 and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue: [n := n + 1. classIndex := newHeap rawHashBitsOf: class. rehashFlags at: classIndex >> 3 + 1 put: ((rehashFlags at: classIndex >> 3 + 1) bitOr: (1 << (classIndex bitAnd: 7)))]]. Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush. n := 0. self withExecutableInterpreter: sim do: [sim setBreakSelector: 'error:'. "don't rehash twice (actually without limit), so don't rehash any new objects created." newHeap allExistingOldSpaceObjectsDo: [:o| | classIndex | classIndex := newHeap classIndexOf: o. ((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue: [(n := n + 1) \\ 8 = 0 ifTrue: [Transcript nextPut: $.; flush]. "2845 = n ifTrue: [self halt]." "Rehash an object if its size is > 0. + Symbol implements rehash, but let's not waste time rehashing it; in Squeak + up to 2013 symbols are kept in a set which will get reashed anyway.. - Symbol implements rehash, but doesn't understand size, so don't send size to classes. Don't rehash empty collections; they may be large for a reason and rehashing will shrink them." ((sim addressCouldBeClassObj: o) or: [(self interpreter: sim object: o perform: (map at: sizeSym) + withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse: - withArguments: #()) ~= (newHeap integerObjectOf: 0)]) ifTrue: [self interpreter: sim object: o perform: (map at: rehashSym) withArguments: #()]]]]! Item was changed: ----- Method: SpurBootstrap>>replacementForCharacterMethod: (in category 'bootstrap methods') ----- replacementForCharacterMethod: characterMethodOop "Answer a replacement method for the argument if it refers to Character's old inst var value. Otherwise answer nil." | proxy asIntegerProxy clone assembly newInsts newMethod | "(oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue: [self halt]." proxy := VMCompiledMethodProxy new for: characterMethodOop coInterpreter: oldInterpreter objectMemory: oldHeap. clone := self cloneMethodProxy: proxy. + "Quick methods accessing value should have been replaced." + clone isReturnField ifTrue: [self halt]. clone hasInstVarRef ifFalse: [^nil]. clone setSourcePointer: 0. asIntegerProxy := VMObjectProxy new for: (symbolMap at: #asInteger) coInterpreter: oldInterpreter objectMemory: oldHeap. assembly := BytecodeDisassembler new disassemble: clone. assembly literals: (assembly literals allButLast: 2), {asIntegerProxy}, (assembly literals last: 2). "Do this by looking for index of pushReceiverVariable: and replacing it by pushSelf, send asInteger" newInsts := (assembly instructions piecesCutWhere: [:msgOrLabelAssoc :nextInst| msgOrLabelAssoc isVariableBinding not and: [msgOrLabelAssoc selector == #pushReceiverVariable:]]) fold: [:a :b| a allButLast, { Message selector: #pushReceiver. Message selector: #send:super:numArgs: arguments: {asIntegerProxy. false. 0}}, b]. assembly instructions: newInsts. newMethod := assembly assemble. ^self installableMethodFor: newMethod selector: clone selector className: #Character isMeta: false! Item was changed: ----- Method: SpurBootstrap>>scavengeImage (in category 'bootstrap image') ----- scavengeImage "Scavenge the image to get it into a simpler state." newHeap coInterpreter voidVMStateForSnapshot. + newHeap flushNewSpace! - newHeap sufficientSpaceAfterGC: 0! Item was changed: ----- Method: SpurBootstrap>>transform (in category 'bootstrap image') ----- transform self rememberRehashSymbol. self installModifiedMethods. self bootstrapImage. self validate. self rehashImage. - self scavengeImage. self followForwardingPointers. + self scavengeImage. Transcript nextPutAll: 'done.'; flush.!

1 0

VM Maker: VMMaker.oscog-eem.391.mcz
by commits＠source.squeak.org 19 Sep '13

19 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.391.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.391 Author: eem Time: 18 September 2013, 6:17:51.359 pm UUID: 99df045e-7d77-463e-821c-084a05ac2491 Ancestors: VMMaker.oscog-eem.390 Make followForwarded: follow chains, after Igor's example on my blog. Make initialInstanceOf: answer nil on failure, to match instanceAfter: Give the generation scavenger a larger remembered set. Should be moved to old space to live on the heap. Implement SpurMemMgr>>flushNewSpace. Fix bug in scavengeReferentsOf: to answer if referrer has new reference after copying referents. Switch order of space enumerations in allObjectsDo:. Dubiousl Will revisit. e.g. allInstances and allObjects primitives are safer. Fix SpurMemMgr>>clone: for immediates and byte objects. =============== Diff against VMMaker.oscog-eem.390 =============== Item was changed: ----- Method: Interpreter>>primitiveSomeInstance (in category 'object access primitives') ----- primitiveSomeInstance | class instance | class := self stackTop. instance := self initialInstanceOf: class. + instance + ifNil: [self primitiveFail] + ifNotNil: [self pop: argumentCount+1 thenPush: instance]! - instance = nilObj - ifTrue: [self primitiveFail] - ifFalse: [self pop: argumentCount+1 thenPush: instance]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveSomeInstance (in category 'object access primitives') ----- primitiveSomeInstance | class instance | class := self stackTop. instance := objectMemory initialInstanceOf: class. + instance + ifNil: [self primitiveFail] + ifNotNil: [self pop: argumentCount+1 thenPush: instance]! - instance = objectMemory nilObject - ifTrue: [self primitiveFail] - ifFalse: [self pop: argumentCount+1 thenPush: instance]! Item was changed: ----- Method: NewspeakInterpreter>>primitiveSomeInstance (in category 'object access primitives') ----- primitiveSomeInstance | class instance | class := self stackTop. instance := self initialInstanceOf: class. + instance + ifNil: [self primitiveFail] + ifNotNil: [self pop: argumentCount+1 thenPush: instance]! - instance = nilObj - ifTrue: [self primitiveFail] - ifFalse: [self pop: argumentCount+1 thenPush: instance]! Item was changed: ----- Method: ObjectMemory>>initialInstanceOf: (in category 'object enumeration') ----- initialInstanceOf: classPointer "Support for instance enumeration. Return the first instance of the given class, or nilObj if it has no instances." | thisObj thisClass | thisObj := self firstAccessibleObject. [thisObj = nil] whileFalse: [thisClass := self fetchClassOf: thisObj. thisClass = classPointer ifTrue: [^ thisObj]. thisObj := self accessibleObjectAfter: thisObj]. + ^nil! - ^ nilObj! Item was changed: ----- Method: SpurGenerationScavenger class>>initialize (in category 'class initialization') ----- initialize "SpurGenerationScavenger initialize" + RememberedSetLimit := 16384. + RememberedSetRedZone := RememberedSetLimit - (RememberedSetLimit // 2)! - RememberedSetLimit := 4096. - RememberedSetRedZone := 1024 * 3! Item was added: + ----- Method: SpurGenerationScavenger>>getRawTenuringThreshold (in category 'accessing') ----- + getRawTenuringThreshold + ^tenuringThreshold! Item was changed: ----- Method: SpurGenerationScavenger>>scavengeReferentsOf: (in category 'scavenger') ----- scavengeReferentsOf: referrer "scavengeReferentsOf: referrer inspects all the pointers in referrer. If any are new objects, it has them moved to FutureSurvivorSpace, and answers truth. If there are no new referents, it answers falsity." | foundNewReferent | "forwarding objects should be followed by callers, unless the forwarder is a root in the remembered table." self assert: ((manager isForwarded: referrer) not or: [manager isRemembered: referrer]). foundNewReferent := false. 0 to: (manager numPointerSlotsOf: referrer) - 1 do: [:i| | referent newLocation | referent := manager fetchPointer: i ofMaybeForwardedObject: referrer. (manager isNonImmediate: referent) ifTrue: ["a forwarding pointer could be because of become: or scavenging." referent := (manager isForwarded: referent) ifTrue: [manager followForwarded: referent] ifFalse: [referent]. (manager isYoung: referent) ifTrue: + ["if target is already in future space forwarding pointer was due to a become:." - [foundNewReferent := true. - "if target is already in future space forwarding pointer was due to a become:." (manager isInFutureSpace: referent) ifTrue: [newLocation := referent] ifFalse: [(manager isForwarded: referent) ifTrue: [self halt. "can this even happen?" newLocation := manager followForwarded: referent] ifFalse: [newLocation := self copyAndForward: referent]]. + (manager isYoung: newLocation) ifTrue: + [foundNewReferent := true]. manager storePointerUnchecked: i ofMaybeForwardedObject: referrer withValue: newLocation] ifFalse: [manager storePointerUnchecked: i ofMaybeForwardedObject: referrer withValue: referent]]]. ^foundNewReferent! Item was added: + ----- Method: SpurGenerationScavenger>>setRawTenuringThreshold: (in category 'accessing') ----- + setRawTenuringThreshold: threshold + tenuringThreshold := threshold! Item was changed: ----- Method: SpurMemoryManager>>addToFreeList: (in category 'free space') ----- addToFreeList: freeChunk | chunkBytes childBytes parent child index | + "coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk." - coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk. chunkBytes := self bytesInObject: freeChunk. index := chunkBytes / self allocationUnit. index < NumFreeLists ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index). freeLists at: index put: freeChunk. freeListsMask := freeListsMask bitOr: 1 << index. ^self]. freeListsMask := freeListsMask bitOr: 1. self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0; storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0; storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0; storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0. "Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [childBytes := self bytesInObject: child. childBytes = chunkBytes ifTrue: "size match; add to list at node." [self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: freeChunk. ^self]. "walk down the tree" parent := child. child := self fetchPointer: (childBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofObject: child]. parent = 0 ifTrue: [self assert: (freeLists at: 0) = 0. freeLists at: 0 put: freeChunk. ^self]. "insert in tree" self storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: parent. self storePointer: (childBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: parent withValue: freeChunk! Item was changed: ----- Method: SpurMemoryManager>>allExistingObjectsDo: (in category 'object enumeration') ----- allExistingObjectsDo: aBlock "Enumerate all objects, excluding any objects created during the execution of allExistingObjectsDo:." <inline: true> + self allExistingNewSpaceObjectsDo: aBlock. + self allExistingOldSpaceObjectsDo: aBlock! - self allExistingOldSpaceObjectsDo: aBlock. - self allExistingNewSpaceObjectsDo: aBlock! Item was changed: ----- Method: SpurMemoryManager>>allObjectsDo: (in category 'object enumeration') ----- allObjectsDo: aBlock <inline: true> + self allNewSpaceObjectsDo: aBlock. + self allOldSpaceObjectsDo: aBlock! - self allOldSpaceObjectsDo: aBlock. - self allNewSpaceObjectsDo: aBlock! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes "Answer a chunk of oldSpace from the free lists, if available, otherwise answer nil. N.B. the chunk is simply a pointer, it has no valid header. The caller *must* fill in the header correctly." | index chunk nextIndex nodeBytes parent child smaller larger | index := chunkBytes / self allocationUnit. (index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [^self unlinkFreeChunk: chunk atIndex: index]. "first search for free chunks of a multiple of chunkBytes in size" nextIndex := index. [1 << index >= freeListsMask and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue: [((freeListsMask anyMask: 1 << index) and: [(chunk := freeLists at: index) ~= 0]) ifTrue: [self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfFreeChunk: chunk) + chunkBytes. ^chunk]]. "now get desperate and use the first that'll fit" nextIndex := index. [1 << index >= freeListsMask and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfFreeChunk: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]]. "Large chunk, or no space on small free lists. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [nodeBytes := self bytesInObject: child. parent := child. nodeBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). ^chunk]. child := 0] "break out of loop to remove interior node" ifFalse:"walk down the tree" [child := self fetchPointer: (nodeBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: child]]. parent = 0 ifTrue: [self halt]. "self printFreeChunk: parent" self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: parent withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfFreeChunk: chunk) + chunkBytes]. ^chunk]. "no list; remove an interior node" chunk := parent. parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. "no parent; stitch the subnodes back into the root" parent = 0 ifTrue: [smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. smaller = 0 ifTrue: [freeLists at: 0 put: larger] ifFalse: [freeLists at: 0 put: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]. + "coInterpreter transcript ensureCr. - coInterpreter transcript ensureCr. coInterpreter print: 'new free tree root '. (freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)]. + coInterpreter cr." - coInterpreter cr. chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfFreeChunk: chunk) + chunkBytes]. ^chunk]. "remove node from tree; reorder tree simply. two cases (which have mirrors, for four total): case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | S | _/_ | S |" self halt. "case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree. add the left subtree to the bottom left of the right subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | R | _/_ _\_ _/_ | L | | R | | L |" self halt! Item was added: + ----- Method: SpurMemoryManager>>booleanObjectOf: (in category 'primitive support') ----- + booleanObjectOf: bool + <inline: true> + ^bool ifTrue: [trueObj] ifFalse: [falseObj]! Item was changed: ----- Method: SpurMemoryManager>>clone: (in category 'allocation') ----- clone: objOop | numSlots newObj | numSlots := self numSlotsOf: objOop. newObj := self allocateSlots: (self numSlotsOf: objOop) format: (self formatOf: objOop) classIndex: (self classIndexOf: objOop). + (self isPointersNonImm: objOop) + ifTrue: + [0 to: numSlots - 1 do: + [:i| | oop | + oop := self fetchPointer: i ofObject: objOop. + ((self isNonImmediate: oop) + and: [self isForwarded: oop]) ifTrue: + [oop := self followForwarded: oop]. + self storePointerUnchecked: i + ofObject: newObj + withValue: oop]. + ((self isRemembered: objOop) + and: [self isYoung: newObj]) ifTrue: + [scavenger remember: objOop. + self setIsRememberedOf: objOop to: true]] + ifFalse: + [0 to: numSlots - 1 do: + [:i| + self storePointerUnchecked: i + ofObject: newObj + withValue: (self fetchPointer: i ofObject: objOop)]]. - 0 to: numSlots - 1 do: - [:i| | oop | - oop := self fetchPointer: i ofObject: objOop. - ((self isNonImmediate: oop) - and: [self isForwarded: oop]) ifTrue: - [oop := self followForwarded: oop]. - self storePointerUnchecked: i - ofObject: newObj - withValue: (self fetchPointer: i ofObject: objOop)]. - (self isRemembered: objOop) ifTrue: - [scavenger remember: objOop. - self setIsRememberedOf: objOop to: true]. ^newObj! Item was added: + ----- Method: SpurMemoryManager>>coInterpreter (in category 'simulation') ----- + coInterpreter + <doNotGenerate> + ^coInterpreter! Item was added: + ----- Method: SpurMemoryManager>>flushNewSpace (in category 'generation scavenging') ----- + flushNewSpace + | savedTenuringThreshold | + savedTenuringThreshold := scavenger getRawTenuringThreshold. + scavenger setRawTenuringThreshold: newSpaceLimit. + self sufficientSpaceAfterGC: 0. + scavenger setRawTenuringThreshold: savedTenuringThreshold. + self assert: scavenger rememberedSetSize = 0. + self assert: pastSpaceStart = scavenger pastSpace start. + self assert: freeStart = scavenger eden start! Item was changed: ----- Method: SpurMemoryManager>>followForwarded: (in category 'become api') ----- followForwarded: objOop + "Follow a forwarding pointer. Alas we cannot prevent forwarders to forwarders + being created by lazy become. Consider the following example by Igor Stasenk: + array := { a. b. c }. + - array at: 1 points to &a. array at: 2 points to &b. array at: 3 points to &c Ó + a becomeForward: b + - array at: 1 still points to &a. array at: 2 still points to &b. array at: 3 still points to &c + b becomeForward: c. + - array at: 1 still points to &a. array at: 2 still points to &b. array at: 3 still points to &c + - when accessing array first one has to follow a forwarding chain: + &a -> &b -> c" | referent | self assert: (self isForwarded: objOop). referent := self fetchPointer: 0 ofMaybeForwardedObject: objOop. + [(self isForwarded: referent)] whileTrue: + [referent := self fetchPointer: 0 ofMaybeForwardedObject: referent]. - self assert: (self isForwarded: referent) not. ^referent! Item was added: + ----- Method: SpurMemoryManager>>initialInstanceOf: (in category 'object enumeration') ----- + initialInstanceOf: classObj + <inline: false> + | classIndex | + classIndex := self rawHashBitsOf: classObj. + classIndex = 0 ifTrue: + [^nil]. + self allObjectsDo: + [:objOop| + classIndex = (self classIndexOf: objOop) ifTrue: + [^objOop]]. + ^nil! Item was added: + ----- 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. + [objOop < freeStart] whileTrue: + [classIndex = (self classIndexOf: actualObj) ifTrue: + [^actualObj]. + actualObj := self objectAfter: objOop limit: freeStart]. + actualObj := pastSpaceStart > scavenger pastSpace start + ifTrue: [self objectStartingAt: scavenger pastSpace start] + ifFalse: [nilObj]]. + (self isInSurvivorSpace: actualObj) ifTrue: + [actualObj := self objectAfter: actualObj limit: pastSpaceStart. + [objOop < pastSpaceStart] whileTrue: + [classIndex = (self classIndexOf: actualObj) ifTrue: + [^actualObj]. + actualObj := self objectAfter: objOop limit: pastSpaceStart]. + actualObj := nilObj]. + actualObj := self objectAfter: actualObj limit: freeOldSpaceStart. + [objOop < freeOldSpaceStart] whileTrue: + [classIndex = (self classIndexOf: actualObj) ifTrue: + [^actualObj]. + actualObj := self objectAfter: objOop limit: freeOldSpaceStart]. + ^nil! Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop "This list records the valid senders of isIntegerObject: as we replace uses of isIntegerObject: by isImmediate: where appropriate." (#( DoIt DoItIn: makeBaseFrameFor: quickFetchInteger:ofObject: frameOfMarriedContext: objCouldBeClassObj: isMarriedOrWidowedContext: shortPrint: bytecodePrimAt bytecodePrimAtPut commonAt: commonAtPut: loadFloatOrIntFrom: positive32BitValueOf: primitiveExternalCall checkedIntegerValueOf: bytecodePrimAtPut commonAtPut: primitiveVMParameter checkIsStillMarriedContext:currentFP: displayBitsOf:Left:Top:Right:Bottom: fetchStackPointerOf: primitiveContextAt primitiveContextAtPut subscript:with:storing:format: + printContext: + compare31or32Bits:equal: + signed64BitValueOf:) includes: thisContext sender method selector) ifFalse: - printContext:) includes: thisContext sender method selector) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0! Item was changed: ----- Method: SpurMemoryManager>>sufficientSpaceAfterGC: (in category 'generation scavenging') ----- sufficientSpaceAfterGC: numBytes "This is ObjectMemory's funky entry-point into its incremental GC, which is a stop-the-world a young generation reclaimer. In Spur we run the scavenger." - self halt. self assert: numBytes = 0. + "coInterpreter printCallStackFP: coInterpreter framePointer" self runLeakCheckerForFullGC: false. coInterpreter preGCAction: GCModeIncr. needGCFlag := false. - gcStartUsecs := coInterpreter ioUTCMicrosecondsNow. scavengeInProgress := true. pastSpaceStart := scavenger scavenge. self assert: (self oop: pastSpaceStart isGreaterThanOrEqualTo: scavenger pastSpace start andLessThanOrEqualTo: scavenger pastSpace limit). freeStart := scavenger eden start. self initSpaceForAllocationCheck: scavenger eden. scavengeInProgress := false. statScavenges := statScavenges + 1. statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow. statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs. statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs. coInterpreter postGCAction. self runLeakCheckerForFullGC: false. ^true! Item was changed: ----- Method: StackInterpreter>>divorceAllFrames (in category 'frame access') ----- divorceAllFrames | activeContext | <inline: false> <var: #aPage type: #'StackPage *'> + stackPage ~= 0 ifTrue: + [self externalWriteBackHeadFramePointers]. - self externalWriteBackHeadFramePointers. activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer. 0 to: numStackPages - 1 do: [:i| | aPage | aPage := stackPages stackPageAt: i. (stackPages isFree: aPage) ifFalse: [self divorceFramesIn: aPage]]. self zeroStackPage. ^activeContext! Item was changed: ----- Method: StackInterpreter>>zeroStackPage (in category 'stack pages') ----- zeroStackPage + "In its own method as a debugging hook. + Frame pointers should have been written back already." - "In its own method as a debugging hook." <inline: true> + self assert: (stackPage = 0 + or: [stackPage headFP = framePointer + and: [stackPage headSP = stackPointer]]). stackPage := 0! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveClone (in category 'object access primitives') ----- primitiveClone "Return a shallow copy of the receiver. Special-case non-single contexts (because of context-to-stack mapping). Can't fail for contexts cuz of image context instantiation code (sigh)." | rcvr newCopy | rcvr := self stackTop. + (objectMemory isImmediate: rcvr) - (objectMemory isIntegerObject: rcvr) ifTrue: [newCopy := rcvr] ifFalse: [(objectMemory isContextNonImm: rcvr) ifTrue: [newCopy := self cloneContext: rcvr] ifFalse: [newCopy := objectMemory clone: rcvr]. newCopy = 0 ifTrue: [^self primitiveFailFor: PrimErrNoMemory]]. self pop: 1 thenPush: newCopy!

1 0

[commit][2784] bring RISC OS src up to date
by commits＠squeakvm.org 19 Sep '13

19 Sep '13

Revision: 2784 Author: rowledge Date: 2013-09-18 18:07:31 -0700 (Wed, 18 Sep 2013) Log Message: ----------- bring RISC OS src up to date Modified Paths: -------------- trunk/platforms/RiscOS/misc/ToCopy/!Squeak/!Help trunk/platforms/RiscOS/misc/ToCopy/!Squeak/!run trunk/platforms/RiscOS/vm/sqRPCEvents.c Added Paths: ----------- trunk/platforms/RiscOS/plugins/SoundPlugin/sqRPCSound.h Modified: trunk/platforms/RiscOS/misc/ToCopy/!Squeak/!Help =================================================================== --- trunk/platforms/RiscOS/misc/ToCopy/!Squeak/!Help 2013-09-10 23:39:47 UTC (rev 2783) +++ trunk/platforms/RiscOS/misc/ToCopy/!Squeak/!Help 2013-09-19 01:07:31 UTC (rev 2784) @@ -3,12 +3,14 @@ What is this? ------------- -This is the RISC OS port of Squeak 3.9, a public domain Smalltalk system. +This is the RISC OS port of Squeak 4.4, a public domain Smalltalk system. Updates, patches etc are available from: http://www.rowledge.org/tim/squeak -as and when I can make time to produce then. The main website for the Squeak project is: +as and when I can make time to produce them. + +The main website for the Squeak project is: http://www.squeak.org -and I suggest you take a look there. +and I suggest you take a look there for news, discussion forums and links. Information herein ------------------ @@ -21,7 +23,7 @@ What is Smalltalk? ------------------ -Smalltalk is the original object oriented programming language and environment from which most OSs have learnt about windowing, pixel displays, menus and so on. You will need to read about Smalltalk to make best use of it, since it is likely to be quite unfamiliar to you at first. +Smalltalk is the original object oriented programming language and environment from which most OSs have learnt about windowing, pixel displays, menus and so on. You will need to read about Smalltalk to make best use of it, since it is likely to be quite unfamiliar to you at first. See below for some links. Be warned, the user interface is not quite like RISC OS; in particular:- a) the right hand mouse button is NOT used as 'adjust', but to operate on the window currently active; thus serving many of the functions of the window icons under RISC OS. @@ -67,21 +69,22 @@ Oddities and Known problems with this release ============================================= -File naming is a problem. Squeak is ported to many machines and far too many people make bad assumptions about the permissable form of file names. RISC OS is the only popular OS to have problems with long filenames (in pre-RISC OS 4 systems), '.' used for filename extensions etc. This shouldn't be a problem in an object oriented system, since we should be able to catch bad behaviour and correct the file names, but there are many places currently in the system where something like 'fred the great.text' is used as a filename. +File naming can be a problem. Squeak is ported to many machines and far too many people make bad assumptions about the permissable form of file names and how they are constructed. This shouldn't be a problem in an object oriented system, since we should be able to catch bad behaviour and correct the file names, but there are many places currently in the system where something like 'fred the great.text' is used as a filename. To get around this problem, I have made Squeak accept Unix style filenames, ie use a '/' as the directory separator and '.' for filename extensions. This is a minor inconvenience in that you have to remember the change from normal RISC OS practice, but we are all getting used to URLs anyway, so it should not be too painful. It does at least save most of the filename troubles with Squeak code. At various times Squeak expects to be able to open a file for read/write and read-only at the same time. RISC OS doesn't support this and so I have had to implement a way to fake it. So far this seems reliable but let me know of problems. -No iconbar menu yet. However, you can bring the Squeak window to the front by clicking on the Squeak iconbar icon. +There is no iconbar menu yet. However, you can bring the Squeak window to the front by clicking on the Squeak iconbar icon. I'm not really sure what we would put in an iconbar menu, anyway. -Hotkeys don't work quite like in RISC OS. Again, since Squeak was first created on a Mac, it is rather biased towards the Mac keyboard layout and shortcuts. Mac's have both a 'cmd' key and a 'ctl' key (and the 'option' key of course but won't worry about that for now) and RPCs have 'ctl' and 'alt' keys. Sadly, we can't map one to the other in a simple way since there are no keypress events generated for most alt-keys. So to get around this I have separated out the left and right ctl keys. The LEFT one is used for 'ctl' (think controL) and the RIGHT for 'cmd' (think commanD => dexter => right). There are still some confusions beyond this in that there are shift-cmd hotkeys available in Squeak, but the ctl key can be used to access them as well. -New for 3.7 is a commandline option to swap these two in case you find it more convenient. Add the flag '-swapMeta' to the final line of the !Run file. +Hotkeys don't work quite like in RISC OS. Again, since Squeak was first created on a Mac, it is rather biased towards the Mac keyboard layout and shortcuts. Mac's have both a 'cmd' key and a 'ctl' key (and the 'option' key of course but won't worry about that for now) and RISC OS understands 'ctl' and 'alt' keys. Sadly, we can't map one to the other in a simple way since there are no keypress events generated for most alt-keys. So to get around this I have separated out the left and right ctl keys. The LEFT one is used for 'ctl' (think controL) and the RIGHT for 'cmd' (think commanD => dexter => right). There are still some confusions beyond this in that there are shift-cmd hotkeys available in Squeak, but the ctl key can be used to access them as well. +There is a commandline option to swap these two in case you find it more convenient. Add the flag '-swapMeta' to the final line of the !Run file. If you don't know what a !run file is, don't worry about it for now. -There is a help window that describes the available hotkeys (use the screen menu, choose 'help...' then 'command key help') that should give you some assistance in understanding things. The ctl-<, ctl-= and cmd-shift-+ actions don't work because RiscOS doesn't generate keypress event for those keys. +There is a Squeak help window that describes the available hotkeys (use the Squeak screen menu, choose 'help...' then 'command key help') that should give you some assistance in understanding things. The ctl-<, ctl-= and cmd-shift-+ actions don't work because RiscOS doesn't generate keypress event for those keys. -Sound is not hooked up yet. Serial ports neither. Nor MIDI. Bummer. Volunteer to help fix this! +Sound suport has been added as of the 4.0 release; Squeak has had sound since 1996 but I didn't get around to adding it for RISC OS until recently. +Serial ports are not supported. Nor MIDI. Bummer. Volunteer to help fix this! -Window resizing - as in the RISC OS window holding all the Squeak windows - is a little non-standard. To resize the window, hold down a ctrl key and press the SELECT mouse button in the bottom right corner (within 15 pixels) and drag to the new size. It will take a moment for the display to catch up with the change so don't worry. +Window resizing - as in resizing the RISC OS window holding all the Squeak windows - is a little non-standard. To resize the window, hold down a ctrl key and press the SELECT mouse button in the bottom right corner (within 15 pixels) and drag to the new size. It will take a moment for the display to catch up with the change so don't worry. Quitting Squeak. Normally one uses the main World Menu and chooses 'quit', 'save and quit' or whatever. If you have a problem and the system is not responding you can also close the Squeak window the normal way and 'accept' in the resulting confirmation dialogue. Modified: trunk/platforms/RiscOS/misc/ToCopy/!Squeak/!run =================================================================== --- trunk/platforms/RiscOS/misc/ToCopy/!Squeak/!run 2013-09-10 23:39:47 UTC (rev 2783) +++ trunk/platforms/RiscOS/misc/ToCopy/!Squeak/!run 2013-09-19 01:07:31 UTC (rev 2784) @@ -23,7 +23,7 @@ | Specify amount of free space to attempt to allocate for Squeak's object | memory. More will be claimed for the display sprite that is used. | 15m == 15 MB, for example. -| I recommend a setting of around double the image file size +| I recommend a setting of around treble the image file size | -useDA | force use of DynamicArea memory even if you are on RISC OS 5 and | Aemulor is not running. @@ -40,4 +40,4 @@ | imageoption - any words following will be available to the image via | Smalltalk getSystemAttribute: -{1000, 1} /<Squeak$Dir>.!Boot -/<Squeak$Dir>.!RunImage -memory:60m %*0 \ No newline at end of file +/<Squeak$Dir>.!RunImage -memory:160m %*0 \ No newline at end of file Added: trunk/platforms/RiscOS/plugins/SoundPlugin/sqRPCSound.h =================================================================== --- trunk/platforms/RiscOS/plugins/SoundPlugin/sqRPCSound.h (rev 0) +++ trunk/platforms/RiscOS/plugins/SoundPlugin/sqRPCSound.h 2013-09-19 01:07:31 UTC (rev 2784) @@ -0,0 +1,74 @@ +// A Squeak VM for RiscOS machines +// Suited to RISC OS > 4, preferably > 5 +// See www.squeak.org for much more information +// +// tim Rowledge tim(a)rowledge.org +// +// License: MIT License - +// Copyright (C) <2013> <tim rowledge> +// +// Permission is hereby granted, free of charge, to any person obtaining a +// copy of this software and associated documentation files (the "Software"), +// to deal in the Software without restriction, including without limitation +// the rights to use, copy, modify, merge, publish, distribute, sublicense, +// and/or sell copies of the Software, and to permit persons to whom the +// Software is furnished to do so, subject to the following conditions: +// +// The above copyright notice and this permission notice shall be included in +// all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +// THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +// DEALINGS IN THE SOFTWARE. +// This is sqRPCSound.c +// It provides Squeak with access to the RISC OS sound system as +// implemented by John Duffell's very neat SharedSoundBuffer/StreamManager +// modules.. Furthermore, my understanding of how to make use of John's modules +// relied on reading Andrew Sellors excellent code for !RDPClient. +// Thank you both. + +#define SOUND_HEAP_MAX_SIZE 4096 * 1024 +#define SOUND_DA_MAX_SIZE 4096 * 1024 +#define SOUND_BLOCK_SIZE 32764 +#define BYTESPERSAMPLE 4 +#define BYTESFROMSAMPLES(numsample) (numsample * BYTESPERSAMPLE) +#define SOUND_BUFFER_SIZE(numsamples) (4* BYTESFROMSAMPLES(numsamples)) + +#ifndef SWI_XOS_Bit +#define SWI_XOS_Bit 0x020000 +#endif + +#define SWI_SharedSoundBuffer_OpenStream 0x55FC0 /* Opens a stream */ +#define SWI_SharedSoundBuffer_CloseStream 0x55FC1 /* Closes and stops a stream immediately */ +#define SWI_SharedSoundBuffer_AddBlock 0x55FC2 /* Adds a block to a stream's queue */ +#define SWI_SharedSoundBuffer_PollWord 0x55FC3 /* Sets up the buffer pollword */ +#define SWI_SharedSoundBuffer_Volume 0x55FC4 /* Set the volume of output */ +#define SWI_SharedSoundBuffer_SampleRate 0x55FC5 /* Set the sample rate */ +#define SWI_SharedSoundBuffer_ReturnSSHandle 0x55FC6 /* Return the internal SharedSound handle */ +#define SWI_SharedSoundBuffer_SetBuffer 0x55FC7 /* Set the stream buffer limit */ +#define SWI_SharedSoundBuffer_BufferStats 0x52E08 /* Find out information about the buffer */ +#define SWI_SharedSoundBuffer_Pause 0x55FC9 /* Pauses playback */ +#define SWI_SharedSoundBuffer_StreamEnd 0x55FCA /* Closes a stream */ +#define SWI_SharedSoundBuffer_Flush 0x55fcc +#define SWI_SharedSoundBuffer_BlockFilled 0x55fcd +#define SWI_SharedSoundBuffer_ReturnStreamHandle 0x55fce + + +#define SWI_StreamManager_OpenStream 0x57280 +#define SWI_StreamManager_CloseStream 0x57281 +#define SWI_StreamManager_AddBlock 0x57282 +#define SWI_StreamManager_BlockFilled 0x57283 +#define SWI_StreamManager_GetBlock 0x57284 +#define SWI_StreamManager_FreeBlocks 0x57285 +#define SWI_StreamManager_SrcPollWord 0x57286 +#define SWI_StreamManager_SetBuffer 0x57287 +#define SWI_StreamManager_BufferStats 0x57288 +#define SWI_StreamManager_Mark 0x57289 +#define SWI_StreamManager_Flush 0x5728a +#define SWI_StreamManager_DestPollWord 0x5728b +#define SWI_StreamManager_SetDALimits 0x5728c + Property changes on: trunk/platforms/RiscOS/plugins/SoundPlugin/sqRPCSound.h ___________________________________________________________________ Added: svn:riscosfiletype + FFF Modified: trunk/platforms/RiscOS/vm/sqRPCEvents.c =================================================================== --- trunk/platforms/RiscOS/vm/sqRPCEvents.c 2013-09-10 23:39:47 UTC (rev 2783) +++ trunk/platforms/RiscOS/vm/sqRPCEvents.c 2013-09-19 01:07:31 UTC (rev 2784) @@ -981,7 +981,7 @@ }; #endif if (iebEmptyP()) { - HandleEvents(); + HandleEventsNotTooOften(); forceInterruptCheck(); /* handleevents can take a while */ } if (iebEmptyP()) return false; @@ -1013,7 +1013,7 @@ */ //PRINTF(("\\t relinq %d\n", microSeconds)); /* HandleEventsWithWait(microSeconds); */ - HandleEvents(); + HandleEventsNotTooOften(); forceInterruptCheck(); return microSeconds; } @@ -1025,7 +1025,7 @@ * the image is up to. We don't force an interrupt check here because we're * in the middle of one already */ - HandleEvents(); + HandleEventsNotTooOften(); return true; }

1 0

← Newer
1
2
3
4
5
6
7
8
9
...
16
Older →

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 September 2013