Vm-dev February 2015

vm-dev@lists.squeakfoundation.org

27 participants
101 discussions

VM Maker: VMMaker.oscog-eem.1039.mcz
by commits＠source.squeak.org 05 Feb '15

05 Feb '15

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1039.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.1039 Author: eem Time: 4 February 2015, 3:17:04.327 pm UUID: 931d69b1-7be3-42dd-8833-1ba325d2b5f2 Ancestors: VMMaker.oscog-eem.1038 Allow primitivePerformWithArgs to avoid fetchClassOf: in Spur by making the last arg to primitiveObject:perform:withArguments:lookedUpIn: lookupClassOrNil. Update Slang constan folding to include nil isNil/notNil. =============== Diff against VMMaker.oscog-eem.1038 =============== Item was changed: ----- Method: CCodeGenerator>>isConstantNode:valueInto: (in category 'utilities') ----- isConstantNode: aNode valueInto: aBlock "Answer if aNode evaluates to a constant, and if so, evaluate aBlock with the value of that constant." aNode isConstant ifTrue: [aBlock value: aNode value. ^true]. + (aNode isVariable + and: [aNode name = #nil]) ifTrue: + [aBlock value: nil. + ^true]. aNode isSend ifFalse: [^false]. (self anyMethodNamed: aNode selector) ifNil: [(VMBasicConstants valueOfBasicSelector: aNode selector) ifNotNil: [:value| aBlock value: value. ^true]] ifNotNil: [:m| (m statements size = 1 and: [m statements last isReturn]) ifTrue: [^self isConstantNode: m statements last expression valueInto: aBlock]]. ^false! Item was changed: ----- Method: CCodeGenerator>>nilOrBooleanConstantReceiverOf: (in category 'utilities') ----- nilOrBooleanConstantReceiverOf: aNode "Answer nil or the boolean constant that is the receiver of the given message send. Used to suppress conditional code when the condition is a translation-time constant." | val receiver argument | generateDeadCode ifTrue:[^nil]. ((self isConstantNode: aNode valueInto: [:v| val := v]) and: [#(true false) includes: val]) ifTrue: [^val]. aNode isSend ifTrue: [aNode selector == #not ifTrue: [(self nilOrBooleanConstantReceiverOf: aNode receiver) ifNotNil: [:bool| ^bool not]]. + ((#(isNil notNil) includes: aNode selector) + and: [self isNilConstantReceiverOf: aNode]) ifTrue: + [^aNode selector == #isNil]. ((#(or: and:) includes: aNode selector) and: [aNode args last isStmtList and: [aNode args last statements size = 1]]) ifTrue: [(self nilOrBooleanConstantReceiverOf: aNode receiver) ifNotNil: [:rcvr| ((rcvr == false and: [aNode selector == #and:]) or: [rcvr == true and: [aNode selector == #or:]]) ifTrue: [^rcvr]. (self nilOrBooleanConstantReceiverOf: aNode args last statements first) ifNotNil: [:arg| ^rcvr perform: aNode selector with: [arg]]]]. ((#(= ~= < > <= >=) includes: aNode selector) and: [(self isConstantNode: aNode receiver valueInto: [:v| receiver := v]) and: [receiver isInteger and: [(self isConstantNode: aNode args first valueInto: [:v| argument := v]) and: [argument isInteger]]]]) ifTrue: [^receiver perform: aNode selector with: argument]]. ^nil! Item was changed: ----- Method: InterpreterPrimitives>>primitivePerformWithArgs (in category 'control primitives') ----- primitivePerformWithArgs + self primitiveObject: (self stackValue: 2) - - | lookupClass rcvr | - rcvr := self stackValue: 2. - lookupClass := objectMemory fetchClassOf: rcvr. - - self primitiveObject: rcvr "a.k.a. self stackValue: 2" perform: (self stackValue: 1) withArguments: self stackTop + lookedUpIn: nil! - lookedUpIn: lookupClass! Item was changed: ----- Method: StackInterpreter>>primitiveObject:perform:withArguments:lookedUpIn: (in category 'control primitives') ----- + primitiveObject: actualReceiver perform: selector withArguments: argumentArray lookedUpIn: lookupClassOrNil - primitiveObject: actualReceiver perform: selector withArguments: argumentArray lookedUpIn: lookupClass "Common routine used by perform:withArgs:, perform:withArgs:inSuperclass:, object:perform:withArgs:inClass: et al. Answer nil on success. NOTE: The case of doesNotUnderstand: is not a failure to perform. The only failures are arg types and consistency of argumentCount. Since we're in the stack VM we can assume there is space to push the arguments provided they are within limits (max argument count is 15). We can therefore deal with the arbitrary amount of state to remove from the stack (lookup class, selector, mirror receiver) and arbitrary argument orders by deferring popping anything until we know whether the send has succeeded. So on failure we merely have to remove the actual receiver and arguments pushed, and on success we have to slide the actual receiver and arguments down to replace the original ones." + <inline: true> - | arraySize performArgCount delta | (objectMemory isArray: argumentArray) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. "Check if number of arguments is reasonable; MaxNumArgs isn't available so just use LargeContextSize" arraySize := objectMemory numSlotsOf: argumentArray. arraySize > LargeContextSlots ifTrue: [^self primitiveFailFor: PrimErrBadNumArgs]. performArgCount := argumentCount. "Push newMethod to save it in case of failure, then push the actual receiver and args out of the array." self push: newMethod. self push: actualReceiver. "Copy the arguments to the stack, and execute" 1 to: arraySize do: [:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)]. argumentCount := arraySize. messageSelector := selector. self sendBreakpoint: messageSelector receiver: actualReceiver. self printSends ifTrue: + [self printActivationNameForSelector: messageSelector + startClass: (lookupClassOrNil isNil + ifTrue: [objectMemory classForClassTag: lkupClassTag] + ifFalse: [lookupClassOrNil]); + cr]. + self findNewMethodInClassTag: (lookupClassOrNil isNil + ifTrue: [objectMemory fetchClassTagOf: actualReceiver] + ifFalse: [objectMemory classTagForClass: lookupClassOrNil]). - [self printActivationNameForSelector: messageSelector startClass: lookupClass; cr]. - self findNewMethodInClassTag: (objectMemory classTagForClass: lookupClass). "Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances" ((objectMemory isOopCompiledMethod: newMethod) and: [(self argumentCountOf: newMethod) ~= argumentCount]) ifTrue: ["Restore the state by popping all those array entries and pushing back the selector and array, and fail" self pop: arraySize + 1. newMethod := self popStack. ^self primitiveFailFor: PrimErrBadNumArgs]. "Cannot fail this primitive from here-on. Slide the actual receiver and arguments down to replace the perform arguments and saved newMethod and then execute the new method. Use argumentCount not arraySize because an MNU may have changed it." delta := objectMemory wordSize * (performArgCount + 2). "+2 = receiver + saved newMethod" argumentCount * objectMemory wordSize to: 0 by: objectMemory wordSize negated do: [:offset| stackPages longAt: stackPointer + offset + delta put: (stackPages longAt: stackPointer + offset)]. self pop: performArgCount + 2. self executeNewMethod. self initPrimCall. "Recursive xeq affects primErrorCode" ^nil!

1 0

VM Maker: VMMaker.oscog-eem.1038.mcz
by commits＠source.squeak.org 04 Feb '15

04 Feb '15

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1038.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.1038 Author: eem Time: 4 February 2015, 2:55:03.718 pm UUID: b980b192-bb2a-4a7b-9ca5-e570007bc55e Ancestors: VMMaker.oscog-eem.1037 Fix 32-bit word reversal in 64-bit Spur and hence fix 64-bit pur image segment loading. Make sure the leak checker is run when image segment leak checking is enabled. Never inline fetchClassOf: in Spur; it's a lot of code and should be rare, dynamically. =============== Diff against VMMaker.oscog-eem.1037 =============== Item was changed: ----- Method: SpurMemoryManager>>fetchClassOfNonImm: (in category 'object access') ----- fetchClassOfNonImm: objOop + <inline: #never> | classIndex | classIndex := self classIndexOf: objOop. classIndex <= self classIsItselfClassIndexPun ifTrue: [classIndex = self classIsItselfClassIndexPun ifTrue: [^objOop]. "Answer nil to avoid the assert failure in classOrNilAtIndex:" classIndex = self isForwardedObjectClassIndexPun ifTrue: [^nilObj]]. self assert: classIndex >= self arrayClassIndexPun. ^self classOrNilAtIndex: classIndex! Item was changed: ----- Method: SpurMemoryManager>>reverseBytesIn32BitWordsFrom:to: (in category 'snapshot') ----- reverseBytesIn32BitWordsFrom: startAddr to: stopAddr "Byte-swap the given range of memory (not inclusive of stopAddr!!)." | addr | addr := startAddr. [self oop: addr isLessThan: stopAddr] whileTrue: [self long32At: addr put: (self byteSwapped32Bits: (self long32At: addr)). + addr := addr + 4]! - addr := addr + self wordSize]! Item was changed: ----- Method: SpurMemoryManager>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') ----- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid <inline: false> (fullGCFlag + ifTrue: [self leakCheckFullGC or: [self leakCheckImageSegments]] - ifTrue: [self leakCheckFullGC] ifFalse: [self leakCheckNewSpaceGC]) ifTrue: [fullGCFlag ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7] ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15]. self clearLeakMapAndMapAccessibleObjects. self assert: (self checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid). self assert: coInterpreter checkInterpreterIntegrity. self assert: coInterpreter checkStackIntegrity. self assert: (coInterpreter checkCodeIntegrity: fullGCFlag)]!

1 0

New Cog VMs available
by Eliot Miranda 04 Feb '15

04 Feb '15

at http://www.mirandabanda.org/files/Cog/VM/VM.r3236/ CogVM binaries as per VMMaker.oscog-eem.1029/r3236 Fix stupid, stupid bug in copying vm profile samples between buffers when the circular buffer index has wrapped. Fix monumental blunder in jitted store-check code. The saved registers mask needs to be the *or* of the value reg and the caller-saved registers, not the *and*!! Make the pin primitives Spur-only. Never inline mapStackPages, for debugging. Spur: Reduce the max num literals in the alternate header format to 15, and steal the bit for the Sista optimized method flag. Make postBecomeAction's stack sweep only occur in Spur (fix regression). Refactor so that the scan is not inlined. Don't assume newMethod is non-immediate in post-become actions. Fix stack adjust slip in primitiveSmallFloatTimesTwoPower Make ensureBehaviorHash: fail for uninitialized behaviours and hence fix the Behavior basicNew basicNew hang. Optionalize some api methods the Spur Cogit doesn't use. Rename and correct ensureSemaphoreForwardedThroughContext: to ensureSemaphoreUnforwardedThroughContext:, its intended function. Make shouldRemapObj: filter-out objects already in newSpace since mapStackPages, via mapInterpreterOops, can visit objects twice in a scavenge, GC, compact sequence. Make sure the caller (& saved) context(s) in base frames stack page are followed post-become in followForwardingPointersInStackZone:. Fix bad bug introduced in become changes in VMMaker.oscog-eem.841 through 844. The class table contains puns, e.g. using Array and WeakArray. These class index puns must not mislead the allInstances primitive into concluding that the class in question is at multiple indices and wrongly purge it. Fix slip in primitivePin. Also be lenient w.r.t. unpinning married contexts. Move the check down into StackInterpreter's version. This allows e.g. self allObjectsDo: [:o| o unpin] Bow to the inevitable and add a manual override for primitive accessor depth. Use it in at: & at:put:. If manual override is not used then the automatically computed depth is too deep because of context access. Newspeak: Integrate Ryan's newer absent receiver sends, which first apeared in VMMaker.oscog-eem.919, abandoned because of Glue issues now resolved. Includes nice refactoring of absent send argument marshalling into its own routine. LargeIntegersPlugin: Remove/fix assumption of 32-bit digit length in normalization routines. -- best, Eliot

5 7

VM Maker: VMMaker.oscog-eem.1037.mcz
by commits＠source.squeak.org 04 Feb '15

04 Feb '15

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1037.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.1037 Author: eem Time: 4 February 2015, 10:48:02.497 am UUID: 36af936c-f30f-4e91-9d1f-4b41f1122891 Ancestors: VMMaker.oscog-eem.1036 Spur image segments: Offset class indices in objects in segment to avoid confusion with forwarders etc. Comment helper methods better. Add 32-bit byte swapping for 64-bit segment support. =============== Diff against VMMaker.oscog-eem.1036 =============== Item was added: + ----- Method: Spur32BitMemoryManager>>byteSwapped32Bits: (in category 'snapshot') ----- + byteSwapped32Bits: w + ^self byteSwapped: w! Item was added: + ----- Method: Spur64BitMemoryManager>>byteSwapped32Bits: (in category 'snapshot') ----- + byteSwapped32Bits: w + "Answer the given 32-bit integer with its bytes in the reverse order." + ^ ((w bitShift: Byte3ShiftNegated) bitAnd: Byte0Mask) + + ((w bitShift: Byte1ShiftNegated) bitAnd: Byte1Mask) + + ((w bitShift: Byte1Shift ) bitAnd: Byte2Mask) + + ((w bitShift: Byte3Shift ) bitAnd: Byte3Mask)! Item was changed: ----- Method: SpurMemoryManager>>assignClassIndicesAndPinFrom:to:outPointers: (in category 'image segment in/out') ----- assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray + "This is part of loadImageSegmentFrom:outPointers:. + Make a final pass, assigning the real class indices and/or pinning pinned objects." - "Make a final pass, assigning class indices and/or pinning pinned objects" | objOop topHashBit | topHashBit := 1 bitShift: self identityHashFieldWidth - 1. objOop := self objectStartingAt: segmentStart. [objOop < segmentLimit] whileTrue: [| classRef classOop classIndex | + "In the segment, class indices are offset indexes into the segment data, + or into outPointers. See mapOopsFrom:to:outPointers:outHashes:." + classRef := (self classIndexOf: objOop) - self firstClassIndexPun. - classRef := self classIndexOf: objOop. classOop := (classRef anyMask: topHashBit) ifTrue: [self fetchPointer: classRef - topHashBit ofObject: outPointerArray] ifFalse: [classRef * self allocationUnit + segmentStart]. classIndex := self rawHashBitsOf: classOop. self assert: (classIndex > self lastClassIndexPun and: [(self classOrNilAtIndex: classIndex) = classOop]). self setClassIndexOf: objOop to: classIndex. ((self isInNewSpace: objOop) and: [self isPinned: objOop]) ifTrue: [| oldClone | oldClone := self cloneInOldSpaceForPinning: objOop. oldClone ~= 0 ifTrue: [self setIsPinnedOf: oldClone to: true. self forward: objOop to: oldClone]]. objOop := self objectAfter: objOop limit: segmentLimit]. ! Item was added: + ----- Method: SpurMemoryManager>>byteSwapped32Bits: (in category 'snapshot') ----- + byteSwapped32Bits: w + self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>loadImageSegmentFrom:outPointers: (in category 'image segment in/out') ----- loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray "This primitive is called from Squeak as... <imageSegment> loadSegmentFrom: aWordArray outPointers: anArray." "This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of one word, i.e. retaining the version stamp. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you have done with it anyway?" <inline: false> | segmentLimit segmentStart segVersion errorCode | segmentLimit := self numSlotsOf: segmentWordArray. (self objectBytesForSlots: segmentLimit) < (self allocationUnit "version info" + self baseHeaderSize "one object header") ifTrue: [^PrimErrBadArgument]. + "Verify format. If the format is wrong, word-swap (since ImageSegment data are 32-bit longs). + If it is still wrong, undo the damage and fail." - "First thing is to verify format. If Spur is ever ported to big-endian machines then the segment - may have to be byte/word swapped, but so far it only runs on little-endian machines, so for now - just fail if endinanness is wrong." segVersion := self longAt: segmentWordArray + self baseHeaderSize. + (coInterpreter readableFormat: (segVersion bitAnd: 16rFFFFFF "low 3 bytes")) ifFalse: + [self reverseBytesIn32BitWordsFrom: segmentWordArray + self baseHeaderSize - (coInterpreter readableFormat: (segVersion bitAnd: 16rFFFF "low 2 bytes")) ifFalse: - [self reverseBytesFrom: segmentWordArray + self baseHeaderSize to: (self addressAfter: segmentWordArray). segVersion := self longAt: segmentWordArray + self baseHeaderSize. + (coInterpreter readableFormat: (segVersion bitAnd: 16rFFFFFF "low 3 bytes")) ifFalse: + [self reverseBytesIn32BitWordsFrom: segmentWordArray + self baseHeaderSize - (coInterpreter readableFormat: (segVersion bitAnd: 16rFFFF "low 2 bytes")) ifFalse: - [self reverseBytesFrom: segmentWordArray + self baseHeaderSize to: (self addressAfter: segmentWordArray). + ^PrimErrBadArgument]]. - ^PrimErrBadArgument]]. segmentStart := segmentWordArray + self baseHeaderSize + self allocationUnit. segmentLimit := segmentLimit * self bytesPerOop + segmentWordArray + self baseHeaderSize. "Notionally reverse the Byte type objects if the data is from opposite endian machine. Test top byte. $d on the Mac or $s on the PC. Rest of word is equal. If Spur is ever ported to big-endian machines then the segment may have to be byte/word swapped, but so far it only runs on little-endian machines, so for now just fail if endinanness is wrong." self flag: #endianness. + (segVersion >> 24 bitAnd: 16rFF) ~= (self imageSegmentVersion >> 24 bitAnd: 16rFF) ifTrue: - (segVersion >> 16) ~= (self imageSegmentVersion >> 16) ifTrue: "Reverse the byte-type objects once" [true ifTrue: [^PrimErrBadArgument] ifFalse: [self byteSwapByteObjectsFrom: (self objectStartingAt: segmentStart) to: segmentLimit flipFloatsIf: false]]. "scan through mapping oops and validating class references. Defer entering any class objects into the class table and/or pinning objects until a second pass." errorCode := self mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray. errorCode ~= 0 ifTrue: [^errorCode]. "Scan for classes contained in the segment, entering them into the class table. Classes are at the front, after the root array and have the remembered bit set." errorCode := self enterClassesIntoClassTableFrom: segmentStart to: segmentLimit. errorCode ~= 0 ifTrue: [^errorCode]. "Make a final pass, assigning class indices and/or pinning pinned objects" self assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray. "Finally evaporate the container, leaving the newly loaded objects in place." (self hasOverflowHeader: segmentWordArray) ifTrue: [self rawOverflowSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop] ifFalse: [self rawNumSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop]. self leakCheckImageSegments ifTrue: [self runLeakCheckerForFullGC: true]. ^self objectStartingAt: segmentStart! Item was changed: ----- Method: SpurMemoryManager>>mapOopsAndValidateClassRefsFrom:to:outPointers: (in category 'image segment in/out') ----- mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray + "This is part of loadImageSegmentFrom:outPointers:. + Scan through mapping oops and validating class references. Defer + entering any class objects into the class table and/or pinning objects + until the second pass in assignClassIndicesAndPinFrom:to:outPointers:." - "scan through mapping oops and validating class references. - Defer entering any class objects into the class table and/or - pinning objects until a second pass." | numOutPointers objOop topHashBit topOopBit | numOutPointers := self numSlotsOf: outPointerArray. topHashBit := 1 bitShift: self identityHashFieldWidth - 1. topOopBit := 1 bitShift: self bytesPerOop * 8 - 1. objOop := self objectStartingAt: segmentStart. [objOop < segmentLimit] whileTrue: [| classIndex hash oop mappedOop | (self isMarked: objOop) ifTrue: [^PrimErrInappropriate]. + classIndex := (self classIndexOf: objOop) - self firstClassIndexPun. - classIndex := self classIndexOf: objOop. "validate the class ref, but don't update it until any internal classes have been added to the class table." (classIndex anyMask: topHashBit) ifTrue: [classIndex - topHashBit >= numOutPointers ifTrue: [^PrimErrBadIndex]. mappedOop := self fetchPointer: classIndex - topHashBit ofObject: outPointerArray. hash := self rawHashBitsOf: mappedOop. (hash > self lastClassIndexPun and: [(self classOrNilAtIndex: hash) = mappedOop]) ifFalse: [^PrimErrInappropriate]] ifFalse: "The class is contained within the segment." [(oop := classIndex * self allocationUnit + segmentStart) >= segmentLimit ifTrue: [^PrimErrBadIndex]. (self rawHashBitsOf: oop) ~= 0 ifTrue: [^PrimErrInappropriate]]. 0 to: (self numPointerSlotsOf: objOop) - 1 do: [:i| oop := self fetchPointer: i ofObject: objOop. (self isNonImmediate: oop) ifTrue: [(oop anyMask: topOopBit) ifTrue: [(oop := oop - topOopBit / self bytesPerOop) >= numOutPointers ifTrue: [^PrimErrBadIndex]. mappedOop := self fetchPointer: oop ofObject: outPointerArray] ifFalse: [(oop bitAnd: self allocationUnit - 1) ~= 0 ifTrue: [^PrimErrInappropriate]. (mappedOop := oop + segmentStart) >= segmentLimit ifTrue: [^PrimErrBadIndex]]. self storePointerUnchecked: i ofObject: objOop withValue: mappedOop]]. objOop := self objectAfter: objOop limit: segmentLimit]. ^0! Item was changed: ----- Method: SpurMemoryManager>>mapOopsFrom:to:outPointers:outHashes: (in category 'image segment in/out') ----- mapOopsFrom: segStart to: segAddr outPointers: outPointerArray outHashes: savedOutHashes + "This is part of storeImageSegmentInto:outPointers:roots:. + Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects + have had their hashes set to point to their copies in segmentWordArray. Answer the + outIndex if the scan succeded. Fail if outPointers is too small and answer -1." - "Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects - have their hashes set to point to their copies in segmentWordArray. Answer the outIndex - if the scan succeded, otherwise answer -1. It will fail if outPointers is too small." | objOop outIndex topHashBit topOopBit | outIndex := 0. self fillObj: outPointerArray numSlots: (self numSlotsOf: outPointerArray) with: nilObj. topHashBit := 1 bitShift: self identityHashFieldWidth - 1. topOopBit := 1 bitShift: self bytesPerOop * 8 - 1. objOop := self objectStartingAt: segStart. [objOop < segAddr] whileTrue: + [| oop segIndex | - [| oop hash | oop := self fetchClassOfNonImm: objOop. (self isMarked: oop) ifFalse: "oop is a new outPointer; allocate its oop" [outIndex := self newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes topHashBit: topHashBit. outIndex = 0 ifTrue:"no room in outPointers; fail" [^-1]]. + "Set the clone's class index to an offset index into segmentWordArray. + Use an offset so that code cannot confuse a clone with e.g. a forwarder." + segIndex := self rawHashBitsOf: oop. + self setClassIndexOf: objOop to: segIndex + self firstClassIndexPun. - hash := self rawHashBitsOf: oop. - self setClassIndexOf: objOop to: hash. 0 to: (self numPointerSlotsOf: objOop) - 1 do: [:i| oop := self fetchPointer: i ofObject: objOop. (self isNonImmediate: oop) ifTrue: [(self isMarked: oop) ifFalse: "oop is a new outPointer; allocate its oop" [outIndex := self newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes topHashBit: topHashBit. outIndex = 0 ifTrue: "no room in outPointers; fail" [^-1]]. oop := self mappedOopOf: oop topHashBit: topHashBit topOopBit: topOopBit.. self storePointerUnchecked: i ofObject: objOop withValue: oop]]. objOop := self objectAfter: objOop limit: segAddr]. ^outIndex! Item was added: + ----- Method: SpurMemoryManager>>reverseBytesIn32BitWordsFrom:to: (in category 'snapshot') ----- + reverseBytesIn32BitWordsFrom: startAddr to: stopAddr + "Byte-swap the given range of memory (not inclusive of stopAddr!!)." + | addr | + addr := startAddr. + [self oop: addr isLessThan: stopAddr] whileTrue: + [self long32At: addr put: (self byteSwapped32Bits: (self long32At: addr)). + addr := addr + self wordSize]!

1 0

VM Maker: Cog.pharo-EstebanLorenzano.242.mcz
by commits＠source.squeak.org 04 Feb '15

04 Feb '15

Esteban Lorenzano uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog.pharo-EstebanLorenzano.242.mcz ==================== Summary ==================== Name: Cog.pharo-EstebanLorenzano.242 Author: EstebanLorenzano Time: 4 February 2015, 4:33:43.279573 pm UUID: cb4461b9-1509-414f-b16a-bf3da6f9f10d Ancestors: Cog-EstebanLorenzano.241 fixes to build the pharo-spur images =============== Diff against Cog-eem.239 =============== Item was changed: + SystemOrganization addCategory: #Cog! + SystemOrganization addCategory: 'Cog-Bootstrapping'! + SystemOrganization addCategory: 'Cog-Morphing Bytecode Set'! + SystemOrganization addCategory: 'Cog-ProcessorPlugins'! + SystemOrganization addCategory: 'Cog-Processors'! + SystemOrganization addCategory: 'Cog-Processors-Tests'! + SystemOrganization addCategory: 'Cog-Scripting'! + SystemOrganization addCategory: 'Cog-Scripts'! + SystemOrganization addCategory: 'Cog-Tests'! - SystemOrganization addCategory: #'Cog-Bootstrapping'! - SystemOrganization addCategory: #'Cog-Morphing Bytecode Set'! - SystemOrganization addCategory: #'Cog-ProcessorPlugins'! - SystemOrganization addCategory: #'Cog-Processors'! - SystemOrganization addCategory: #'Cog-Processors-Tests'! - SystemOrganization addCategory: #'Cog-Scripting'! - SystemOrganization addCategory: #'Cog-Scripts'! - SystemOrganization addCategory: #'Cog-Tests'! Item was changed: ----- Method: Behavior>>BehaviorPROTOTYPEinstSize (in category '*Cog-method prototypes') ----- BehaviorPROTOTYPEinstSize "Answer the number of named instance variables (as opposed to indexed variables) of the receiver. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size>" ^format bitAnd: 16rFFFF! Item was changed: ----- Method: Behavior>>BehaviorPROTOTYPEinstSpec (in category '*Cog-method prototypes') ----- BehaviorPROTOTYPEinstSpec "Answer the instance specification part of the format that defines what kind of object an instance of the receiver is. The formats are 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" ^(format bitShift: -16) bitAnd: 16r1F! Item was changed: ----- Method: BlockClosure>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category '*Cog-method prototypes') ----- BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity." | newContext sz | + newContext := (Context newForMethod: outerContext method) - newContext := (MethodContext newForMethod: outerContext method) setSender: aContext receiver: outerContext receiver method: outerContext method closure: self startpc: startpc. ((newContext objectClass: anArray) ~~ Array or: [numArgs ~= anArray size]) ifTrue: + [^Context primitiveFailTokenFor: nil]. - [^ContextPart primitiveFailTokenFor: nil]. sz := self basicSize. newContext stackp: sz + numArgs. 1 to: numArgs do: [:i| newContext at: i put: (anArray at: i)]. 1 to: sz do: [:i| newContext at: i + numArgs put: (self at: i)]. ^newContext! Item was added: + ----- Method: ClassDescription>>ClassDescriptionPROTOTYPEmethodClassAssociation: (in category '*Cog-method prototypes squeak') ----- + ClassDescriptionPROTOTYPEmethodClassAssociation: aBinding + "sets the association to the class that I am installed in" + ^self literalAt: self numLiterals put: aBinding! Item was changed: ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEinitialize (in category '*Cog-method prototypes') ----- CompiledMethodclassPROTOTYPEinitialize "CompiledMethod initialize" "Initialize class variables specifying the size of the temporary frame needed to run instances of me." SmallFrame := 16. "Context range for temps+stack" LargeFrame := 56. PrimaryBytecodeSetEncoderClass ifNil: [PrimaryBytecodeSetEncoderClass := EncoderForV3PlusClosures]. SecondaryBytecodeSetEncoderClass ifNil: [SecondaryBytecodeSetEncoderClass := EncoderForV3PlusClosures]! Item was changed: ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category '*Cog-method prototypes') ----- CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue: [^self]. (aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse: [self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder']. (self allSubInstances detect: [:m| m header >= 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]] ifNone: []) ifNotNil: [Warning signal: 'There are existing CompiledMethods with a different encoderClass.']. PrimaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass! Item was changed: ----- Method: CompiledMethod>>CompiledMethodPROTOTYPEencoderClass (in category '*Cog-method prototypes') ----- CompiledMethodPROTOTYPEencoderClass "Answer the encoder class that encoded the bytecodes in this method. The sign flag bit is used by the VM to select a bytecode set. This formulation may seem odd but this has to be fast, so no property probe unless needed." ^self header >= 0 ifTrue: [PrimaryBytecodeSetEncoderClass] ifFalse: [PrimaryBytecodeSetEncoderClass == SecondaryBytecodeSetEncoderClass ifTrue: "Support for testing prior to installing another set" [(self propertyValueAt: #encoderClass) ifNil: [SecondaryBytecodeSetEncoderClass]] ifFalse: [SecondaryBytecodeSetEncoderClass]]! Item was changed: ----- Method: Context>>ContextPROTOTYPEdoPrimitive:method:receiver:args: (in category '*Cog-method prototypes') ----- ContextPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: aReceiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ Smalltalk tools debugger openContext: self label:'Code simulation error' contents: nil]. ((primitiveIndex between: 201 and: 222) + and: [(self objectClass: aReceiver) includesBehavior: BlockClosure]) ifTrue: - and: [aReceiver class includesBehavior: BlockClosure]) ifTrue: [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" [^aReceiver simulateValueWithArguments: arguments caller: self]. primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" [^aReceiver simulateValueWithArguments: arguments first caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [^self send: arguments first to: aReceiver with: arguments allButFirst super: false]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (self objectClass: aReceiver)]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| active effective | active := Processor activeProcess. effective := active effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [aReceiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [aReceiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" [^Context sender: self receiver: aReceiver method: (arguments at: 2) arguments: (arguments at: 1)]. "Closure primitives" (primitiveIndex = 200 and: [self == aReceiver]) ifTrue: "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right" [^self push: (BlockClosure outerContext: aReceiver startpc: pc + 2 numArgs: arguments first copiedValues: arguments last)]. primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 2 and: [arguments first isInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^Context primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: aReceiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: aReceiver withArgs: arguments] ifFalse: [aReceiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]! Item was changed: ----- Method: Context>>ContextPROTOTYPEisPrimFailToken: (in category '*Cog-method prototypes') ----- ContextPROTOTYPEisPrimFailToken: anObject + ^(self objectClass: anObject) == Array - ^ anObject class == Array and: [anObject size = 2 and: [anObject first == PrimitiveFailToken]]! Item was removed: - ----- Method: ContextPart>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category '*Cog-method prototypes') ----- - ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments - "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and - arguments are given as arguments to this message. If successful, push result and return - resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes - execution needs to be intercepted and simulated to avoid execution running away." - - | value | - "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents - the debugger from entering various run-away activities such as spawning a new - process, etc. Injudicious use results in the debugger not being able to debug - interesting code, such as the debugger itself. hence use primitive 19 with care :-)" - "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" - primitiveIndex = 19 ifTrue: - [ToolSet - debugContext: self - label:'Code simulation error' - contents: nil]. - - ((primitiveIndex between: 201 and: 222) - and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: - [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" - or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" - [^receiver simulateValueWithArguments: arguments caller: self]. - primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" - [^receiver simulateValueWithArguments: arguments first caller: self]]. - - primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" - [^self send: arguments first to: receiver with: arguments allButFirst super: false]. - primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" - [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. - primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" - [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. - - "Mutex>>primitiveEnterCriticalSection - Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" - (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: - [| active effective | - active := Processor activeProcess. - effective := active effectiveProcess. - "active == effective" - value := primitiveIndex = 186 - ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] - ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. - ^(self isPrimFailToken: value) - ifTrue: [value] - ifFalse: [self push: value]]. - - primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" - [^MethodContext - sender: self - receiver: receiver - method: (arguments at: 2) - arguments: (arguments at: 1)]. - - "Closure primitives" - (primitiveIndex = 200 and: [self == receiver]) ifTrue: - "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right" - [^self push: (BlockClosure - outerContext: receiver - startpc: pc + 2 - numArgs: arguments first - copiedValues: arguments last)]. - - primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM" - [(arguments size = 2 - and: [arguments first isInteger - and: [(self objectClass: arguments last) == Array]]) ifFalse: - [^ContextPart primitiveFailTokenFor: nil]. - ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. - - value := primitiveIndex = 120 "FFI method" - ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] - ifFalse: - [primitiveIndex = 117 "named primitives" - ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] - ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. - - ^(self isPrimFailToken: value) - ifTrue: [value] - ifFalse: [self push: value]! Item was removed: - ----- Method: ContextPart>>ContextPartPROTOTYPEisPrimFailToken: (in category '*Cog-method prototypes') ----- - ContextPartPROTOTYPEisPrimFailToken: anObject - ^(self objectClass: anObject) == Array - and: [anObject size = 2 - and: [anObject first == PrimitiveFailToken]]! Item was changed: ----- Method: Decompiler>>DecompilerPROTOTYPEdecompile:in:method:using: (in category '*Cog-method prototypes squeak 4.3') ----- DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor | block node | constructor := aConstructor. method := aMethod. self initSymbols: aClass. "create symbol tables" method isQuick ifTrue: [block := self quickMethod] ifFalse: [stack := OrderedCollection new: method frameSize. lastJumpIfPcStack := OrderedCollection new. caseExits := OrderedCollection new. statements := OrderedCollection new: 20. numLocalTemps := 0. super method: method pc: method initialPC. "skip primitive error code store if necessary" (method primitive ~= 0 and: [self skipCallPrimitive; willStore]) ifTrue: [pc := pc + (method encoderClass bytecodeSize: self firstByte). tempVars := tempVars asOrderedCollection]. block := self blockTo: method endPC + 1. stack isEmpty ifFalse: [self error: 'stack not empty']]. node := constructor codeMethod: aSelector block: block tempVars: tempVars primitive: method primitive class: aClass. method primitive > 0 ifTrue: [node removeAndRenameLastTempIfErrorCode]. ^node preen! Item was changed: ----- Method: InstructionStream>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category '*Cog-method prototypes') ----- InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client | type offset2 byte2 byte3 byte4 | offset <= 6 ifTrue: ["Extended op codes 128-134" byte2 := method at: pc. pc := pc + 1. offset <= 2 ifTrue: ["128-130: extended pushes and pops" type := byte2 // 64. offset2 := byte2 \\ 64. offset = 0 ifTrue: [type = 0 ifTrue: [^client pushReceiverVariable: offset2]. type = 1 ifTrue: [^client pushTemporaryVariable: offset2]. type = 2 ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)]. type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]]. offset = 1 ifTrue: [type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2]. type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2]. type = 2 ifTrue: [self error: 'illegalStore']. type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]]. offset = 2 ifTrue: [type = 0 ifTrue: [^client popIntoReceiverVariable: offset2]. type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2]. type = 2 ifTrue: [self error: 'illegalStore']. type = 3 ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]]. "131-134: extended sends" offset = 3 ifTrue: "Single extended send" [^client send: (method literalAt: byte2 \\ 32 + 1) super: false numArgs: byte2 // 32]. offset = 4 ifTrue: "Double extended do-anything" [byte3 := method at: pc. pc := pc + 1. type := byte2 // 32. type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1) super: false numArgs: byte2 \\ 32]. type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1) super: true numArgs: byte2 \\ 32]. type = 2 ifTrue: [^client pushReceiverVariable: byte3]. type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)]. type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)]. type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3]. type = 6 ifTrue: [^client popIntoReceiverVariable: byte3]. type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]]. offset = 5 ifTrue: "Single extended send to super" [^client send: (method literalAt: byte2 \\ 32 + 1) super: true numArgs: byte2 // 32]. offset = 6 ifTrue: "Second extended send" [^client send: (method literalAt: byte2 \\ 64 + 1) super: false numArgs: byte2 // 64]]. offset = 7 ifTrue: [^client doPop]. offset = 8 ifTrue: [^client doDup]. offset = 9 ifTrue: [^client pushActiveContext]. byte2 := method at: pc. pc := pc + 1. offset = 10 ifTrue: [^byte2 < 128 ifTrue: [client pushNewArrayOfSize: byte2] ifFalse: [client pushConsArrayWithElements: byte2 - 128]]. byte3 := method at: pc. pc := pc + 1. offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)]. offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3]. offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3]. offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3]. "offset = 15" byte4 := method at: pc. pc := pc + 1. ^client pushClosureCopyNumCopiedValues: (byte2 bitShift: -4) numArgs: (byte2 bitAnd: 16rF) blockSize: (byte3 * 256) + byte4! Item was changed: ----- Method: InstructionStream>>InstructionStreamPROTOTYPEnextPc: (in category '*Cog-method prototypes') ----- InstructionStreamPROTOTYPEnextPc: currentByte "Answer the pc of the next bytecode following the current one, given the current bytecode.." ^pc + (self method encoderClass bytecodeSize: currentByte)! Item was changed: ----- Method: MCClassDefinition>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category '*Cog-method prototypes squeak 4.3') ----- MCClassDefinitionPROTOTYPEkindOfSubclass type = #normal ifTrue: [^' subclass: ']. type = #variable ifTrue: [^' variableSubclass: ']. type = #bytes ifTrue: [^' variableByteSubclass: ']. type = #compiledMethod ifTrue: [^' variableByteSubclass: ' ]. type = #words ifTrue: [^' variableWordSubclass: ']. type = #weak ifTrue: [^' weakSubclass: ' ]. type = #ephemeron ifTrue: [^' ephemeronSubclass: ' ]. type = #immediate ifTrue: [^' immediateSubclass: ' ]. self error: 'Unrecognized class type'! Item was changed: ----- Method: MCMethodDefinition>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category '*Cog-method prototypes squeak 4.3') ----- MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString classIsMeta: metaBoolean selector: selectorString category: catString timeStamp: timeString source: sourceString className := classString asSymbol. selector := selectorString asSymbol. category := catString ifNil: [Categorizer default] ifNotNil: [catString asSymbol]. timeStamp := timeString. classIsMeta := metaBoolean. source := sourceString withSqueakLineEndings! Item was removed: - ----- Method: MethodContext>>MethodContextPROTOTYPEfailPrimitiveWith: (in category '*Cog-method prototypes') ----- - MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken - "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive: - bytecode and store the primitive fail code if there is one and the method consumes it." - self skipCallPrimitive. - ((self isPrimFailToken: maybePrimFailToken) - and: [method encoderClass isStoreAt: pc in: method]) ifTrue: - [self at: stackp put: maybePrimFailToken last]! Item was removed: - ----- Method: MethodContext>>xray (in category '*Cog-Tests-xrays') ----- - xray - "Lift the veil from a context and answer an integer describing its interior state. - Used for e.g. VM tests so they can verify they're testing what they think they're testing. - 0 implies a vanilla heap context. - Bit 0 = is or was married to a frame - Bit 1 = is still married to a frame - Bit 2 = frame is executing machine code - Bit 3 = has machine code pc (as opposed to nil or a bytecode pc) - Bit 4 = method is currently compiled to machine code" - <primitive: 213> - ^0 "Can only fail if unimplemented; therefore simply answer 0"! Item was removed: - ----- Method: MethodContext>>xrayIsDivorced (in category '*Cog-Tests-xrays') ----- - xrayIsDivorced - ^(self xray bitAnd: 3) = 1! Item was removed: - ----- Method: MethodContext>>xrayIsExecutingMachineCode (in category '*Cog-Tests-xrays') ----- - xrayIsExecutingMachineCode - ^self xray anyMask: 4! Item was removed: - ----- Method: MethodContext>>xrayIsMarried (in category '*Cog-Tests-xrays') ----- - xrayIsMarried - ^self xray anyMask: 2! Item was removed: - ----- Method: MethodContext>>xrayLastExecutedMachineCode (in category '*Cog-Tests-xrays') ----- - xrayLastExecutedMachineCode - ^self xray anyMask: 8! Item was removed: - ----- Method: MethodContext>>xrayMethodIsCompiledToMachineCode (in category '*Cog-Tests-xrays') ----- - xrayMethodIsCompiledToMachineCode - ^self xray anyMask: 16! Item was changed: ----- Method: SimulatorHarness>>interpreter:object:perform:withArguments: (in category 'bootstrap methods') ----- interpreter: sim object: receiver perform: selector withArguments: arguments "Interpret an expression in oldHeap using oldInterpreter. Answer the result." | fp savedpc savedsp savedStackPages result startByteCount | self assert: ({receiver. selector}, arguments allSatisfy: [:oop| oop isInteger and: [sim objectMemory addressCouldBeOop: oop]]). savedpc := sim localIP. savedsp := sim localSP. savedStackPages := Set with: sim stackPage. sim internalPush: receiver. arguments do: [:arg| sim internalPush: arg]. sim argumentCount: arguments size; messageSelector: selector. fp := sim localFP. startByteCount := sim byteCount. "sim byteCount = 66849 ifTrue: [self halt]." sim normalSend. sim incrementByteCount. "otherwise, send is not counted" ["sim printFrame: sim localFP WithSP: sim localSP" "sim setBreakSelector: #elementsForwardIdentityTo:" "sim byteCount = 66849 ifTrue: [self halt]." "(sim byteCount > 7508930 and: [sim localFP = -16r27894]) ifTrue: [self halt]." fp = sim localFP] whileFalse: [sim singleStep. (savedStackPages includes: sim stackPage) ifFalse: "If the stack gets deep something has probably gone wrong..." [savedStackPages size > 20 ifTrue: [self halt]. savedStackPages add: sim stackPage]]. result := sim internalPopStack. self assert: savedsp = sim localSP. self assert: sim localIP - 1 = savedpc. sim localIP: savedpc. ^result! Item was changed: ----- Method: SimulatorHarness>>withExecutableInterpreter:do: (in category 'bootstrap methods') ----- withExecutableInterpreter: sim do: aBlock "With the oldInterpreter ready to execute code, evaluate aBlock, then return the interpreter (and the heap) to the ``just snapshotted'' state." | savedpc savedfp initialContext finalContext | sim initStackPages; loadInitialContext; internalizeIPandSP. savedpc := sim localIP. savedfp := sim localFP. "sim printHeadFrame." aBlock value. "sim printHeadFrame." sim internalPush: sim localIP; externalizeIPandSP. "now undo the execution state" self assert: sim localFP = savedfp. initialContext := sim frameContext: savedfp. finalContext := sim voidVMStateForSnapshotFlushingExternalPrimitivesIf: false. self assert: initialContext = finalContext. self assert: sim localIP = savedpc. sim objectMemory storePointer: SuspendedContextIndex ofObject: sim activeProcess withValue: finalContext! Item was changed: ----- Method: SpurBootstrap>>allPrototypeMethodSymbols (in category 'method prototypes') ----- allPrototypeMethodSymbols "self basicNew allPrototypeMethodSymbols" | symbols | + "self assert: SpurBootstrap isolatedPrototypes isEmpty." - self assert: SpurBootstrap isolatedPrototypes isEmpty. symbols := Set new. self prototypeClassNameMetaSelectorMethodDo: [:className :isMeta :selector :method | | adder | symbols add: className; add: selector. adder := [:lit| (lit isSymbol and: [lit ~~ method selector]) ifTrue: [symbols add: lit]. lit isArray ifTrue: [lit do: adder]]. method literals do: adder]. ^symbols! Item was changed: ----- Method: SpurBootstrap>>allocateClassTable (in category 'bootstrap image') ----- allocateClassTable "Allocate the root of the classTable plus enough pages to accomodate all classes in the classToIndex map. Don't fill in the entries yet; the classes have yet to be cloned." | tableRoot page maxSize numPages | tableRoot := newHeap allocateSlots: newHeap classTableRootSlots + newHeap hiddenRootSlots format: newHeap arrayFormat classIndex: newHeap arrayClassIndexPun. self assert: (newHeap numSlotsOf: tableRoot) = (newHeap classTableRootSlots + newHeap hiddenRootSlots). self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat. self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun. newHeap nilFieldsOf: tableRoot. "first page is strong" page := newHeap allocateSlots: newHeap classTablePageSize format: newHeap arrayFormat classIndex: newHeap arrayClassIndexPun. self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize. self assert: (newHeap formatOf: tableRoot) = newHeap arrayFormat. self assert: (newHeap classIndexOf: tableRoot) = newHeap arrayClassIndexPun. self assert: (newHeap objectAfter: tableRoot limit: newHeap freeStart) = page. lastClassTablePage := page. newHeap nilFieldsOf: page. newHeap storePointer: 0 ofObject: tableRoot withValue: page. newHeap setHiddenRootsObj: tableRoot. maxSize := classToIndex inject: 0 into: [:a :b| a max: b]. numPages := (maxSize + newHeap classTableMinorIndexMask / newHeap classTablePageSize) truncated. 2 to: numPages do: [:i| page := newHeap allocateSlots: newHeap classTablePageSize format: newHeap arrayFormat classIndex: newHeap arrayClassIndexPun. self assert: (newHeap numSlotsOf: page) = newHeap classTablePageSize. self assert: (newHeap formatOf: page) = newHeap arrayFormat. self assert: (newHeap classIndexOf: page) = newHeap arrayClassIndexPun. newHeap fillObj: page numSlots: newHeap classTablePageSize with: newHeap nilObject. newHeap storePointer: i - 1 ofObject: tableRoot withValue: page. self assert: (newHeap objectAfter: (newHeap fetchPointer: i - 2 ofObject: tableRoot) limit: newHeap freeStart) = page. lastClassTablePage := page]. "and once again to recompute numClassTablePages post building the class table." newHeap instVarNamed: 'numClassTablePages' put: nil. newHeap setHiddenRootsObj: tableRoot! Item was changed: ----- Method: SpurBootstrap>>bootstrapImageUsingFileReference: (in category 'public access') ----- bootstrapImageUsingFileReference: imageName | dirName baseName dir | dirName := imageName asFileReference parent fullName. baseName := (imageName endsWith: '.image') ifTrue: [ imageName asFileReference base ] ifFalse: [ (imageName, '.image') asFileReference base ]. dir := dirName asFileReference. self on: (dir / (baseName, '.image')) fullName. [self transform] on: Halt do: [:ex| "suppress halts from the usual suspects (development time halts)" (#(fullGC compactImage) includes: ex signalerContext sender selector) ifTrue: [ex resume] ifFalse: [ex pass]]. self writeSnapshot: (dir / (baseName, '-spur.image')) fullName ofTransformedImage: newHeap headerFlags: oldInterpreter getImageHeaderFlags screenSize: oldInterpreter savedWindowSize. (dir / (baseName, '.changes')) copyTo: (dir / (baseName, '-spur.changes'))! Item was changed: ----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') ----- rehashImage "Rehash all collections in newHeap. Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags. Enumerate all objects, rehashing those whose class has a bit set in rehashFlags." | n sim rehashFlags dotDate rehashSym sizeSym | rehashSym := map at: (self findSymbol: #rehash). sizeSym := map at: (self findSymbol: #size). + sim := StackInterpreterSimulator + onObjectMemory: newHeap + options: { + #IMMUTABILITY->false. + #MULTIPLEBYTECODESETS->false. + #NewspeakVM->false. + #ObjectMemory->#Spur32BitMemoryManager. + #SistaVM->false. + #SqueakV3ObjectMemory->false. + #SpurObjectMemory->true } asDictionary. - sim := StackInterpreterSimulator onObjectMemory: newHeap. sim setImageHeaderFlagsFrom: oldInterpreter getImageHeaderFlags; imageName: 'spur image'; assertValidExecutionPointersAtEachStep: false.. newHeap coInterpreter: sim. sim bootstrapping: true. sim initializeInterpreter: 0. sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal. + + sim redirectTranscriptToHost. newHeap setHashBitsOf: newHeap nilObject to: 1; setHashBitsOf: newHeap falseObject to: 2; setHashBitsOf: newHeap trueObject to: 3. rehashFlags := ByteArray new: newHeap numClassTablePages * newHeap classTablePageSize. n := 0. newHeap classTableObjectsDo: [:class| | classIndex | sim messageSelector: rehashSym. "Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self." ((sim 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. dotDate := Time now asSeconds. n := 0. self withExecutableInterpreter: sim do: [sim setBreakSelector: 'error:'. "don't rehash twice (actually without limit), so don't rehash any new objects created." newHeap allExistingOldSpaceObjectsDo: [:o| | classIndex | classIndex := newHeap classIndexOf: o. ((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue: [Time now asSeconds > dotDate ifTrue: [Transcript nextPut: $.; flush. dotDate := Time now asSeconds]. "2845 = n ifTrue: [self halt]." "Rehash an object if its size is > 0. Symbol implements rehash, but let's not waste time rehashing it; in Squeak up to 2013 symbols are kept in a set which will get reashed anyway.. Don't rehash empty collections; they may be large for a reason and rehashing will shrink them." ((sim addressCouldBeClassObj: o) or: [(self interpreter: sim object: o perform: sizeSym withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse: [self interpreter: sim object: o perform: rehashSym withArguments: #()]]]]! Item was changed: ----- Method: SpurBootstrap>>validate (in category 'bootstrap image') ----- validate | p n duplicates maxClassIndex savedEndOfMemory | self assert: (reverseMap at: newHeap specialObjectsOop) = oldHeap specialObjectsOop. self assert: (map at: oldHeap specialObjectsOop) = newHeap specialObjectsOop. self assert: (reverseMap at: newHeap classTableRootObj ifAbsent: []) isNil. duplicates := { 3. newHeap arrayClassIndexPun. newHeap weakArrayClassIndexPun }. maxClassIndex := classToIndex inject: 0 into: [:a :b| a max: b]. self assert: ((newHeap arrayClassIndexPun to: maxClassIndex) select: [:idx| | classObj | (classObj := newHeap classOrNilAtIndex: idx) ~= newHeap nilObject and: [(newHeap classIndexOf: classObj) = (newHeap rawHashBitsOf: classObj)]]) isEmpty. 0 to: maxClassIndex do: [:index| | classObj | (index <= newHeap tagMask and: [index > newHeap isForwardedObjectClassIndexPun]) ifTrue: [(classObj := newHeap classOrNilAtIndex: index) = newHeap nilObject ifTrue: [self assert: (classToIndex keyAtValue: index ifAbsent: []) isNil] ifFalse: [self assert: (newHeap classIndexOf: classObj) ~= (newHeap rawHashBitsOf: classObj). (duplicates includes: index) ifFalse: [self assert: (newHeap rawHashBitsOf: classObj) = index]]]]. classToIndex keysAndValuesDo: [:oldClass :idx| self assert: (newHeap rawHashBitsOf: (map at: oldClass)) = idx. self assert: oldClass = (reverseMap at: (newHeap classAtIndex: idx))]. n := 0. savedEndOfMemory := newHeap endOfMemory. newHeap setEndOfMemory: newHeap freeOldSpaceStart. newHeap allObjectsDo: [:o| (o <= newHeap trueObject or: [o > lastClassTablePage]) ifTrue: [self assert: (reverseMap includesKey: o). self assert: (newHeap fetchClassOfNonImm: o) = (map at: (oldHeap fetchClassOfNonImm: (reverseMap at: o)))]. n := n + 1. p := o]. newHeap setEndOfMemory: savedEndOfMemory. self touch: p. self assert: (n between: map size and: map size + ((imageTypes includes: 'squeak') ifTrue: [6] + ifFalse: [10])). "+ 6 or 10 is room for freelists & classTable" - ifFalse: [8])). "+ 6 or 8 is room for freelists & classTable" "check some class properties to ensure the format changes are correct" self assert: (newHeap fixedFieldsOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = 0. self assert: (newHeap instSpecOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = newHeap arrayFormat! Item was added: + ----- Method: SpurBootstrapMonticelloPackagePatcher>>updateTrunkRepository (in category 'repository population') ----- + updateTrunkRepository + "Download all the Collections, Kernel and System packages from trunk into srcDir, + patch them into destDir, + upload the patched and branched files that aren't already in trunk to trunk." + "self new from: 'trunkpackages' to: 'spurpackages'; updateTrunkRepository" + "AndreasSystemProfiler spyOn: [self new from: 'trunkpackages' to: 'spurpackages'; updateSpurRepository]" + sourceDir assureExistence. + self download: self class squeak45baseline from: self trunk. + destDir assureExistence. + self patchAsNeeded. + self uploadFrom: (MCDirectoryRepository directory: destDir) to: self trunk! Item was added: + ----- Method: SpurBootstrapMonticelloPackagePatcher>>versionFor: (in category 'patching') ----- + versionFor: packageFileName + ^sourceDir + readOnlyFileNamed: packageFileName + do: [:fs| + ((MCVersionReader readerClassForFileNamed: fs fullName) + on: fs fileName: fs fullName) + version]! Item was added: + SpurBootstrapSqueakFamilyPrototypes subclass: #SpurBootstrapOldSqueakPrototypes + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Cog-Bootstrapping'! Item was added: + ----- Method: SpurBootstrapOldSqueakPrototypes class>>imageType (in category 'accessing') ----- + imageType + ^ 'old squeak'! Item was added: + ----- Method: SpurBootstrapOldSqueakPrototypes>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category 'method prototypes') ----- + InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client + | type offset2 byte2 byte3 byte4 | + offset <= 6 ifTrue: + ["Extended op codes 128-134" + byte2 := method at: pc. pc := pc + 1. + offset <= 2 ifTrue: + ["128-130: extended pushes and pops" + type := byte2 // 64. + offset2 := byte2 \\ 64. + offset = 0 ifTrue: + [type = 0 ifTrue: [^client pushReceiverVariable: offset2]. + type = 1 ifTrue: [^client pushTemporaryVariable: offset2]. + type = 2 ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)]. + type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]]. + offset = 1 ifTrue: + [type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2]. + type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2]. + type = 2 ifTrue: [self error: 'illegalStore']. + type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]]. + offset = 2 ifTrue: + [type = 0 ifTrue: [^client popIntoReceiverVariable: offset2]. + type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2]. + type = 2 ifTrue: [self error: 'illegalStore']. + type = 3 ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]]. + "131-134: extended sends" + offset = 3 ifTrue: "Single extended send" + [^client send: (method literalAt: byte2 \\ 32 + 1) + super: false numArgs: byte2 // 32]. + offset = 4 ifTrue: "Double extended do-anything" + [byte3 := method at: pc. pc := pc + 1. + type := byte2 // 32. + type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1) + super: false numArgs: byte2 \\ 32]. + type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1) + super: true numArgs: byte2 \\ 32]. + type = 2 ifTrue: [^client pushReceiverVariable: byte3]. + type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)]. + type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)]. + type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3]. + type = 6 ifTrue: [^client popIntoReceiverVariable: byte3]. + type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]]. + offset = 5 ifTrue: "Single extended send to super" + [^client send: (method literalAt: byte2 \\ 32 + 1) + super: true + numArgs: byte2 // 32]. + offset = 6 ifTrue: "Second extended send" + [^client send: (method literalAt: byte2 \\ 64 + 1) + super: false + numArgs: byte2 // 64]]. + offset = 7 ifTrue: [^client doPop]. + offset = 8 ifTrue: [^client doDup]. + offset = 9 ifTrue: [^client pushActiveContext]. + byte2 := method at: pc. pc := pc + 1. + offset = 10 ifTrue: + [^byte2 < 128 + ifTrue: [client pushNewArrayOfSize: byte2] + ifFalse: [client pushConsArrayWithElements: byte2 - 128]]. + byte3 := method at: pc. pc := pc + 1. + offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)]. + offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3]. + offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3]. + offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3]. + "offset = 15" + byte4 := method at: pc. pc := pc + 1. + ^client + pushClosureCopyNumCopiedValues: (byte2 bitShift: -4) + numArgs: (byte2 bitAnd: 16rF) + blockSize: (byte3 * 256) + byte4! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>BehaviorPROTOTYPEbasicIdentityHash (in category 'method prototypes') ----- BehaviorPROTOTYPEbasicIdentityHash "Answer a SmallInteger whose value is related to the receiver's identity. Behavior implements identityHash to allow the VM to use an object representation which does not include a direct reference to an object's class in an object. If the VM is using this implementation then classes are held in a class table and instances contain the index of their class in the table. A class's class table index is its identityHash so that an instance can be created without searching the table for a class's index. The VM uses this primitive to enter the class into the class table, assigning its identityHash with an as yet unused class table index. If this primitive fails it means that the class table is full. In Spur as of 2014 there are 22 bits of classTable index and 22 bits of identityHash per object. Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive." <primitive: 175> self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>BehaviorPROTOTYPElargeIdentityHash (in category 'method prototypes') ----- BehaviorPROTOTYPElargeIdentityHash "Answer a SmallInteger whose value is related to the receiver's identity. Behavior implements identityHash to allow the VM to use an object representation which does not include a direct reference to an object's class in an object. If the VM is using this implementation then classes are held in a class table and instances contain the index of their class in the table. A class's class table index is its identityHash so that an instance can be created without searching the table for a class's index. The VM uses this primitive to enter the class into the class table, assigning its identityHash with an as yet unused class table index. If this primitive fails it means that the class table is full. In Spur as of 2014 there are 22 bits of classTable index and 22 bits of identityHash per object." <primitive: 175> self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') ----- CharacterPROTOTYPEsetValue: newValue self error: 'Characters are immutable'! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>ContextclassPROTOTYPEallInstances (in category 'method prototypes') ----- ContextclassPROTOTYPEallInstances "Answer all instances of the receiver." <primitive: 177> "The primitive can fail because memory is low. If so, fall back on the old enumeration code, which gives the system a chance to GC and/or grow. Because aBlock might change the class of inst (for example, using become:), it is essential to compute next before aBlock value: inst. Only count until thisContext since this context has been created only to compute the existing instances." | inst insts next | insts := WriteStream on: (Array new: 64). inst := self someInstance. [inst == thisContext or: [inst == nil]] whileFalse: [next := inst nextInstance. insts nextPut: inst. inst := next]. ^insts contents! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>ContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') ----- ContextclassPROTOTYPEallInstancesDo: aBlock "Evaluate aBlock with each of the current instances of the receiver." | instances inst next | instances := self allInstancesOrNil. instances ifNotNil: [instances do: aBlock. ^self]. "allInstancesOrNil can fail because memory is low. If so, fall back on the old enumeration code. Because aBlock might change the class of inst (for example, using become:), it is essential to compute next before aBlock value: inst. Only count until thisContext since evaluation of aBlock will create new contexts." inst := self someInstance. [inst == thisContext or: [inst == nil]] whileFalse: [next := inst nextInstance. aBlock value: inst. inst := next]! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>ProtoObjectPROTOTYPEidentityHash (in category 'method prototypes') ----- ProtoObjectPROTOTYPEidentityHash "Answer a SmallInteger whose value is related to the receiver's identity. This method must not be overridden, except by SmallInteger. As of 2014, the 32-bit Spur VM has 22 bits of hash and 31-bit SmallIntegers (30 bits + 1 sign bit). Shifting by 8 will not create large integers. Do not override." ^self basicIdentityHash bitShift: 8! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') ----- SlotClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex "Compute the new format for making oldClass a subclass of newSuper. Answer the format or nil if there is any problem." | instSize isVar isWords isPointers isWeak | type == #compiledMethod ifTrue: [newInstSize > 0 ifTrue: [self error: 'A compiled method class cannot have named instance variables'. ^nil]. ^CompiledMethod format]. instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]). instSize > 65535 ifTrue: [self error: 'Class has too many instance variables (', instSize printString,')'. ^nil]. type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true]. type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false]. type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false]. type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false]. type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true]. type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true]. type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true]. (isPointers not and: [instSize > 0]) ifTrue: [self error: 'A non-pointer class cannot have named instance variables'. ^nil]. ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') ----- SlotClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak "Compute the format for the given instance specfication. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = reserved for 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" | instSpec | instSpec := isWeak ifTrue: [isVar ifTrue: [4] ifFalse: [5]] ifFalse: [isPointers ifTrue: [isVar ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]] ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]] ifFalse: [isVar ifTrue: [isWords ifTrue: [12] ifFalse: [16]] ifFalse: [7]]]. ^(instSpec bitShift: 16) + nInstVars! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') ----- SlotClassBuilderPROTOTYPEsuperclass: aClass immediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new immediate class as a subclass of an existing class." | env | aClass instSize > 0 ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields']. aClass isVariable ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables']. aClass isPointers ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields']. "Cope with pre-environment and environment versions. Simplify asap." env := (Smalltalk classNamed: #EnvironmentRequest) ifNil: [aClass environment] ifNotNil: [:erc| erc signal ifNil: [aClass environment]]. ^self name: t inEnvironment: env subclassOf: aClass type: #immediate instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') ----- SlotClassBuilderPROTOTYPEupdate: oldClass to: newClass "Convert oldClass, all its instances and possibly its meta class into newClass, instances of newClass and possibly its meta class. The process is surprisingly simple in its implementation and surprisingly complex in its nuances and potentially bad side effects. We can rely on two assumptions (which are critical): #1: The method #updateInstancesFrom: will not create any lasting pointers to 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do a become of the old vs. the new instances and therefore it will not create pointers to *new* instances before the #become: which are *old* afterwards) #2: The non-preemptive execution of the critical piece of code guarantees that nobody can get a hold by 'other means' (such as process interruption and reflection) on the old instances. Given the above two, we know that after #updateInstancesFrom: there are no pointers to any old instances. After the forwarding become there will be no pointers to the old class or meta class either. Andreas Raab, 2/27/2003 23:42" | meta | meta := oldClass isMeta. "Note: Everything from here on will run without the ability to get interrupted to prevent any other process to create new instances of the old class." ["Note: The following removal may look somewhat obscure and needs an explanation. When we mutate the class hierarchy we create new classes for any existing subclass. So it may look as if we don't have to remove the old class from its superclass. However, at the top of the hierarchy (the first class we reshape) that superclass itself is not newly created so therefore it will hold both the oldClass and newClass in its (obsolete or not) subclasses. Since the #become: below will transparently replace the pointers to oldClass with newClass the superclass would have newClass in its subclasses TWICE. With rather unclear effects if we consider that we may convert the meta-class hierarchy itself (which is derived from the non-meta class hierarchy). Due to this problem ALL classes are removed from their superclass just prior to converting them. Here, breaking the superclass/subclass invariant really doesn't matter since we will effectively remove the oldClass (becomeForward:) just a few lines below." oldClass superclass removeSubclass: oldClass. oldClass superclass removeObsoleteSubclass: oldClass. "make sure that the VM cache is clean" oldClass methodDict do: [:cm | cm flushCache]. "Convert the instances of oldClass into instances of newClass" newClass updateInstancesFrom: oldClass. meta ifTrue: [oldClass becomeForward: newClass. oldClass updateMethodBindingsTo: oldClass binding] ifFalse: [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}. oldClass updateMethodBindingsTo: oldClass binding. oldClass class updateMethodBindingsTo: oldClass class binding]. "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was to ensure no old instances existed after the becomeForward:. Without the GC it was possible to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward: updated references from the old objects to new objects but didn't destroy the old objects. But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."] valueUnpreemptively! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>SmalltalkImagePROTOTYPEnewSpecialObjectsArray (in category 'method prototypes') ----- SmalltalkImagePROTOTYPEnewSpecialObjectsArray "Smalltalk recreateSpecialObjectsArray" "To external package developers: **** DO NOT OVERRIDE THIS METHOD. ***** If you are writing a plugin and need additional special object(s) for your own use, use addGCRoot() function and use own, separate special objects registry " "The Special Objects Array is an array of objects used by the Squeak virtual machine. Its contents are critical and accesses to it by the VM are unchecked, so don't even think of playing here unless you know what you are doing." | newArray | newArray := Array new: 60. "Nil false and true get used throughout the interpreter" newArray at: 1 put: nil. newArray at: 2 put: false. newArray at: 3 put: true. "This association holds the active process (a ProcessScheduler)" newArray at: 4 put: (self globals associationAt: #Processor). "Numerous classes below used for type checking and instantiation" newArray at: 5 put: Bitmap. newArray at: 6 put: SmallInteger. newArray at: 7 put: ByteString. newArray at: 8 put: Array. newArray at: 9 put: Smalltalk. + newArray at: 10 put: BoxedFloat64. - newArray at: 10 put: Float. newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]). newArray at: 12 put: nil. "was BlockContext." newArray at: 13 put: Point. newArray at: 14 put: LargePositiveInteger. newArray at: 15 put: Display. newArray at: 16 put: Message. newArray at: 17 put: CompiledMethod. newArray at: 18 put: ((self primitiveGetSpecialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore" newArray at: 19 put: Semaphore. newArray at: 20 put: Character. newArray at: 21 put: #doesNotUnderstand:. newArray at: 22 put: #cannotReturn:. newArray at: 23 put: nil. "This is the process signalling low space." "An array of the 32 selectors that are compiled as special bytecodes, paired alternately with the number of arguments each takes." newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1 #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1 #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0 #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ). "An array of the 255 Characters in ascii order. Cog inlines table into machine code at: prim so do not regenerate it. This is nil in Spur, which has immediate Characters." newArray at: 25 put: (self primitiveGetSpecialObjectsArray at: 25). newArray at: 26 put: #mustBeBoolean. newArray at: 27 put: ByteArray. newArray at: 28 put: Process. "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur" newArray at: 29 put: self compactClassesArray. newArray at: 30 put: ((self primitiveGetSpecialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore" newArray at: 31 put: ((self primitiveGetSpecialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore" "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization" newArray at: 32 put: nil. "was the prototype Float" newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger" newArray at: 34 put: nil. "was the prototype Point" newArray at: 35 put: #cannotInterpret:. newArray at: 36 put: nil. "was the prototype MethodContext" newArray at: 37 put: BlockClosure. newArray at: 38 put: nil. "was the prototype BlockContext" "array of objects referred to by external code" newArray at: 39 put: (self primitiveGetSpecialObjectsArray at: 39). "external semaphores" newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs" newArray at: 41 put: ((self primitiveGetSpecialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT" newArray at: 42 put: ((self primitiveGetSpecialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore" newArray at: 43 put: LargeNegativeInteger. "External objects for callout. Note: Written so that one can actually completely remove the FFI." newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []). newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []). newArray at: 46 put: (self at: #ExternalData ifAbsent: []). newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []). newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []). newArray at: 49 put: #aboutToReturn:through:. newArray at: 50 put: #run:with:in:. "51 reserved for immutability message" newArray at: 51 put: #attemptToAssign:withIndex:. newArray at: 52 put: #(nil "nil => generic error" #'bad receiver' #'bad argument' #'bad index' #'bad number of arguments' #'inappropriate operation' #'unsupported operation' #'no modification' #'insufficient object memory' #'insufficient C memory' #'not found' #'bad method' #'internal error in named primitive machinery' #'object may move' #'resource limit exceeded' #'object is pinned' #'primitive write beyond end of object'). "53 to 55 are for Alien" newArray at: 53 put: (self at: #Alien ifAbsent: []). newArray at: 54 put: #invokeCallbackContext:. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks." newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []). "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support." newArray at: 56 put: nil. "reserved for foreign callback process" newArray at: 57 put: (self primitiveGetSpecialObjectsArray at: 57 ifAbsent: []). newArray at: 58 put: #unusedBytecode. "59 reserved for Sista counter tripped message" newArray at: 59 put: #conditionalBranchCounterTrippedOn:. "60 reserved for Sista class trap message" newArray at: 60 put: #classTrapFor:. ^newArray! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstances (in category 'method prototypes') ----- TraitBehaviorPROTOTYPEallInstances "Answer all instances of the receiver." self error: 'Traits does not have instances.'! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') ----- TraitBehaviorPROTOTYPEallInstancesDo: aBlock "Evaluate aBlock with each of the current instances of the receiver." self error: 'Traits does not have instances.'! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisBits (in category 'method prototypes') ----- TraitBehaviorPROTOTYPEisBits "Answer whether the receiver contains just bits (not pointers). Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" ^self instSpec >= 7! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisBytes (in category 'method prototypes') ----- TraitBehaviorPROTOTYPEisBytes "Answer whether the receiver has 8-bit instance variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" ^self instSpec >= 16! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') ----- TraitBehaviorPROTOTYPEisEphemeronClass "Answer whether the receiver has ephemeral instance variables. The garbage collector will fire (queue for finalization) any ephemeron whose first instance variable is not referenced other than from the transitive closure of references from ephemerons. Hence referring to an object from the first inst var of an ephemeron will cause the ephemeron to fire when the rest of the system does not refer to the object and that object is ready to be collected. Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron from firing, ephemerons may act as the associations in weak dictionaries such that the value (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced other than from ephemerons. Ephemerons can therefore be used to implement instance-based pre-mortem finalization." ^self instSpec = 5! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') ----- TraitBehaviorPROTOTYPEisImmediateClass "Answer whether the receiver has immediate instances. Immediate instances store their value in their object pointer, not in an object body. Hence immediates take no space and are immutable. The immediates are distinguished by tag bits in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit system SmallIntegers are 31-bit signed integers and Characters are 30-bit unsigned character codes." ^self instSpec = 7! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisVariable (in category 'method prototypes') ----- TraitBehaviorPROTOTYPEisVariable "Answer whether the receiver has indexable variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" | instSpec | instSpec := self instSpec. ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') ----- TraitBehaviorPROTOTYPEkindOfSubclass "Answer a String that is the keyword that describes the receiver's kind of subclass, either a regular subclass, a variableSubclass, a variableByteSubclass, a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass. c.f. typeOfClass" ^self isVariable ifTrue: [self isBits ifTrue: [self isBytes ifTrue: [' variableByteSubclass: '] ifFalse: [' variableWordSubclass: ']] ifFalse: [self isWeak ifTrue: [' weakSubclass: '] ifFalse: [' variableSubclass: ']]] ifFalse: [self isImmediateClass ifTrue: [' immediateSubclass: '] ifFalse: [self isEphemeronClass ifTrue: [' ephemeronSubclass: '] ifFalse: [' subclass: ']]]! Item was added: + ----- Method: SpurBootstrapPharoPrototypes>>VirtualMachinePROTOTYPEisSpur (in category 'method prototypes') ----- + VirtualMachinePROTOTYPEisSpur + "this value is always true but is here for backward compatibility (non Spur images should return false)" + ^ true! Item was changed: ----- Method: SpurBootstrapPharoPrototypes>>VirtualMachinePROTOTYPEsetGCParameters (in category 'method prototypes') ----- VirtualMachinePROTOTYPEsetGCParameters "Adjust the VM's default GC parameters to avoid too much tenuring. Maybe this should be left to the VM?" | proportion edenSize survivorSize averageObjectSize numObjects | proportion := 0.9. "tenure when 90% of pastSpace is full" edenSize := self parameterAt: 44. survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)" averageObjectSize := 8 * self wordSize. "a good approximation" numObjects := (proportion * survivorSize / averageObjectSize) rounded. self tenuringThreshold: numObjects "tenure when more than this many objects survive the GC"! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstances (in category 'method prototypes') ----- BehaviorPROTOTYPEallInstances "Answer all instances of the receiver." <primitive: 177> "The primitive can fail because memory is low. If so, fall back on the old enumeration code, which gives the system a chance to GC and/or grow. Because aBlock might change the class of inst (for example, using become:), it is essential to compute next before aBlock value: inst." | inst insts next | insts := WriteStream on: (Array new: 64). inst := self someInstance. [inst == nil] whileFalse: [next := inst nextInstance. (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst]. inst := next]. ^insts contents! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') ----- BehaviorPROTOTYPEallInstancesDo: aBlock "Evaluate aBlock with each of the current instances of the receiver." | instances inst next | instances := self allInstancesOrNil. instances ifNotNil: [instances do: aBlock. ^self]. "allInstancesOrNil can fail because memory is low. If so, fall back on the old enumeration code. Because aBlock might change the class of inst (for example, using become:), it is essential to compute next before aBlock value: inst." inst := self someInstance. [inst == nil] whileFalse: [next := inst nextInstance. aBlock value: inst. inst := next]! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstancesOrNil (in category 'method prototypes') ----- BehaviorPROTOTYPEallInstancesOrNil "Answer all instances of the receiver, or nil if the primitive fails, which it may be due to being out of memory." <primitive: 177> ^nil! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbasicNew (in category 'method prototypes') ----- BehaviorPROTOTYPEbasicNew "Primitive. Answer an instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable. Essential. See Object documentation whatIsAPrimitive. If the primitive fails because space is low then the scavenger will run before the method is activated. Check that space was low and retry via handleFailingBasicNew if so." <primitive: 70 error: ec> ec == #'insufficient object memory' ifTrue: [^self handleFailingBasicNew]. self isVariable ifTrue: [^self basicNew: 0]. self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbasicNew: (in category 'method prototypes') ----- BehaviorPROTOTYPEbasicNew: sizeRequested "Primitive. Answer an instance of this class with the number of indexable variables specified by the argument, sizeRequested. Fail if this class is not indexable or if the argument is not a positive Integer, or if there is not enough memory available. Essential. See Object documentation whatIsAPrimitive. If the primitive fails because space is low then the scavenger will run before the method is activated. Check args and retry via handleFailingBasicNew: if they're OK." <primitive: 71 error: ec> ec == #'insufficient object memory' ifTrue: [^self handleFailingBasicNew: sizeRequested]. self isVariable ifFalse: [self error: self printString, ' cannot have variable sized instances']. self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbyteSizeOfInstance (in category 'method prototypes') ----- BehaviorPROTOTYPEbyteSizeOfInstance "Answer the total memory size of an instance of the receiver." <primitive: 181 error: ec> self isVariable ifTrue: [^self byteSizeOfInstanceOfSize: 0]. self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: (in category 'method prototypes') ----- BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: basicSize "Answer the total memory size of an instance of the receiver with the given number of indexable instance variables." <primitive: 181 error: ec> self isVariable ifTrue: "If the primitive overflowed answer a close approximation" [(basicSize isInteger and: [basicSize >= 16r1000000]) ifTrue: [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2) - (self byteSizeOfInstanceOfSize: 0)]] ifFalse: [basicSize = 0 ifTrue: [^self byteSizeOfInstance]]. self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEelementSize (in category 'method prototypes') ----- BehaviorPROTOTYPEelementSize "Answer the size in bytes of an element in the receiver. The formats are 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" | instSpec | instSpec := self instSpec. instSpec < 9 ifTrue: [^Smalltalk wordSize]. instSpec >= 16 ifTrue: [^1]. instSpec >= 12 ifTrue: [^2]. instSpec >= 10 ifTrue: [^4]. ^8! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingBasicNew (in category 'method prototypes') ----- BehaviorPROTOTYPEhandleFailingBasicNew "handleFailingBasicNew gets sent after basicNew has failed and allowed a scavenging garbage collection to occur. The scavenging collection will have happened as the VM is activating the (failing) basicNew. If handleFailingBasicNew fails then the scavenge failed to reclaim sufficient space and a global garbage collection is required. Retry after garbage collecting and growing memory if necessary. Primitive. Answer an instance of this class with the number of indexable variables specified by the argument, sizeRequested. Fail if this class is not indexable or if the argument is not a positive Integer, or if there is not enough memory available. Essential. See Object documentation whatIsAPrimitive." <primitive: 70> Smalltalk garbageCollect < 1048576 ifTrue: [Smalltalk growMemoryByAtLeast: 1048576]. ^self handleFailingFailingBasicNew "retry after global garbage collect"! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingBasicNew: (in category 'method prototypes') ----- BehaviorPROTOTYPEhandleFailingBasicNew: sizeRequested "handleFailingBasicNew: gets sent after basicNew: has failed and allowed a scavenging garbage collection to occur. The scavenging collection will have happened as the VM is activating the (failing) basicNew:. If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient space and a global garbage collection is required. Retry after garbage collecting and growing memory if necessary. Primitive. Answer an instance of this class with the number of indexable variables specified by the argument, sizeRequested. Fail if this class is not indexable or if the argument is not a positive Integer, or if there is not enough memory available. Essential. See Object documentation whatIsAPrimitive." <primitive: 71> | bytesRequested | bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested. Smalltalk garbageCollect < bytesRequested ifTrue: [Smalltalk growMemoryByAtLeast: bytesRequested]. "retry after global garbage collect and possible grow" ^self handleFailingFailingBasicNew: sizeRequested! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingFailingBasicNew (in category 'method prototypes') ----- BehaviorPROTOTYPEhandleFailingFailingBasicNew "This basicNew gets sent after handleFailingBasicNew: has done a full garbage collection and possibly grown memory. If this basicNew fails then the system really is low on space, so raise the OutOfMemory signal. Primitive. Answer an instance of this class with the number of indexable variables specified by the argument, sizeRequested. Fail if this class is not indexable or if the argument is not a positive Integer, or if there is not enough memory available. Essential. See Object documentation whatIsAPrimitive." <primitive: 70> "space must be low" OutOfMemory signal. ^self basicNew "retry if user proceeds"! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingFailingBasicNew: (in category 'method prototypes') ----- BehaviorPROTOTYPEhandleFailingFailingBasicNew: sizeRequested "This basicNew: gets sent after handleFailingBasicNew: has done a full garbage collection and possibly grown memory. If this basicNew: fails then the system really is low on space, so raise the OutOfMemory signal. Primitive. Answer an instance of this class with the number of indexable variables specified by the argument, sizeRequested. Fail if this class is not indexable or if the argument is not a positive Integer, or if there is not enough memory available. Essential. See Object documentation whatIsAPrimitive." <primitive: 71> "space must be low." OutOfMemory signal. ^self basicNew: sizeRequested "retry if user proceeds"! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEindexIfCompact (in category 'method prototypes') ----- BehaviorPROTOTYPEindexIfCompact "Backward compatibility with the Squeak V3 object format. Spur does not have a distinction between compact and non-compact classes." ^0! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisBits (in category 'method prototypes') ----- BehaviorPROTOTYPEisBits "Answer whether the receiver contains just bits (not pointers). Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" ^self instSpec >= 7! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisBytes (in category 'method prototypes') ----- BehaviorPROTOTYPEisBytes "Answer whether the receiver has 8-bit instance variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" ^self instSpec >= 16! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') ----- BehaviorPROTOTYPEisEphemeronClass "Answer whether the receiver has ephemeral instance variables. The garbage collector will fire (queue for finalization) any ephemeron whose first instance variable is not referenced other than from the transitive closure of references from ephemerons. Hence referring to an object from the first inst var of an ephemeron will cause the ephemeron to fire when the rest of the system does not refer to the object and that object is ready to be collected. Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron from firing, ephemerons may act as the associations in weak dictionaries such that the value (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced other than from ephemerons. Ephemerons can therefore be used to implement instance-based pre-mortem finalization." ^self instSpec = 5! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') ----- BehaviorPROTOTYPEisImmediateClass "Answer whether the receiver has immediate instances. Immediate instances store their value in their object pointer, not in an object body. Hence immediates take no space and are immutable. The immediates are distinguished by tag bits in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit system SmallIntegers are 31-bit signed integers and Characters are 30-bit unsigned character codes." ^self instSpec = 7! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisVariable (in category 'method prototypes') ----- BehaviorPROTOTYPEisVariable "Answer whether the receiver has indexable variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" | instSpec | instSpec := self instSpec. ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') ----- BehaviorPROTOTYPEkindOfSubclass "Answer a String that is the keyword that describes the receiver's kind of subclass, either a regular subclass, a variableSubclass, a variableByteSubclass, a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass. c.f. typeOfClass" ^self isVariable ifTrue: [self isBits ifTrue: [self isBytes ifTrue: [' variableByteSubclass: '] ifFalse: [' variableWordSubclass: ']] ifFalse: [self isWeak ifTrue: [' weakSubclass: '] ifFalse: [' variableSubclass: ']]] ifFalse: [self isImmediateClass ifTrue: [' immediateSubclass: '] ifFalse: [self isEphemeronClass ifTrue: [' ephemeronSubclass: '] ifFalse: [' subclass: ']]]! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEshouldNotBeRedefined (in category 'method prototypes') ----- BehaviorPROTOTYPEshouldNotBeRedefined "Answer if the receiver should not be redefined. The assumption is that classes in Smalltalk specialObjects and instance-specific Behaviors should not be redefined" ^(Smalltalk specialObjectsArray identityIndexOf: self ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0! Item was changed: ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEtypeOfClass (in category 'method prototypes') ----- BehaviorPROTOTYPEtypeOfClass "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass" self isBytes ifTrue: [^self instSpec = CompiledMethod instSpec ifTrue: [#compiledMethod] "Very special!!" ifFalse: [#bytes]]. (self isWords and: [self isPointers not]) ifTrue: [^self instSpec = SmallInteger instSpec ifTrue: [#immediate] "Very special!!" ifFalse: [#words]]. self isWeak ifTrue: [^#weak]. self isVariable ifTrue: [^#variable]. self isEphemeronClass ifTrue: [^#ephemeron]. ^#normal! Item was added: + ----- Method: SpurBootstrapPrototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') ----- + BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext + <indirect>! Item was changed: ----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') ----- BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex numArgs > 15 ifTrue: [^self error: 'Cannot compile -- too many arguments']. numTemps > 63 ifTrue: [^self error: 'Cannot compile -- too many temporary variables']. numLits > 65535 ifTrue: [^self error: 'Cannot compile -- too many literals']. ^(CompiledMethod headerFlagForEncoder: self) + (numArgs bitShift: 24) + (numTemps bitShift: 18) "+ (largeBit bitShift: 17)" "largeBit gets filled in later" + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]) + numLits! Item was changed: ----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEsizeCallPrimitive: (in category 'method prototypes') ----- BytecodeEncoderPROTOTYPEsizeCallPrimitive: primitiveIndex ^self sizeOpcodeSelector: #genCallPrimitive: withArguments: {primitiveIndex}! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEDollarEquals: (in category 'method prototypes') ----- CharacterPROTOTYPEDollarEquals: aCharacter "Primitive. Answer if the receiver and the argument are the same object (have the same object pointer). Optional. See Object documentation whatIsAPrimitive." <primitive: 110> ^self == aCharacter! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasInteger (in category 'method prototypes') ----- CharacterPROTOTYPEasInteger "Answer the receiver's character code." <primitive: 171> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasciiValue (in category 'method prototypes') ----- CharacterPROTOTYPEasciiValue "Answer the receiver's character code. This will be ascii for characters with value <= 127, and Unicode for those with higher values." <primitive: 171> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEcopy (in category 'method prototypes') ----- CharacterPROTOTYPEcopy "Answer the receiver, because Characters are unique." ^self! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEdeepCopy (in category 'method prototypes') ----- CharacterPROTOTYPEdeepCopy "Answer the receiver, because Characters are unique." ^self! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEhash (in category 'method prototypes') ----- CharacterPROTOTYPEhash "Hash is reimplemented because = is implemented. Answer the receiver's character code." <primitive: 171> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEidentityHash (in category 'method prototypes') ----- CharacterPROTOTYPEidentityHash "Answer the receiver's character code." <primitive: 171> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEveryDeepCopyWith: (in category 'method prototypes') ----- CharacterPROTOTYPEveryDeepCopyWith: deepCopier "Answer the receiver, because Characters are unique." ^self! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEdigitValue: (in category 'method prototypes') ----- CharacterclassPROTOTYPEdigitValue: x "Answer the Character whose digit value is x. For example, answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35." | n | n := x asInteger. ^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') ----- CharacterclassPROTOTYPEinitialize "Create the DigitsValues table." "Character initialize" self initializeDigitValues! Item was changed: ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEvalue: (in category 'method prototypes') ----- CharacterclassPROTOTYPEvalue: anInteger "Answer the Character whose value is anInteger." <primitive: 170> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>ClassDescriptionPROTOTYPEupdateInstancesFrom: (in category 'method prototypes') ----- ClassDescriptionPROTOTYPEupdateInstancesFrom: oldClass "Recreate any existing instances of the argument, oldClass, as instances of the receiver, which is a newly changed class. Permute variables as necessary, and forward old instances to new instances.. Answer nil to defeat any clients that expected the old behaviour of answering the array of old instances." "ar 7/15/1999: The updating below is possibly dangerous. If there are any contexts having an old instance as receiver it might crash the system if the new receiver in which the context is executed has a different layout. See bottom below for a simple example:" + self + updateInstances: oldClass allInstances asArray + from: oldClass + isMeta: self isMeta. - self updateInstances: oldClass allInstances asArray from: oldClass isMeta: self isMeta. - "Now fix up instances in segments that are out on the disk." - ImageSegment allSubInstancesDo: - [:seg | - seg segUpdateInstancesOf: oldClass toBe: self isMeta: self isMeta]. ^nil "This attempts to crash the VM by stepping off the end of an instance. As the doctor says, do not do this." " | crashingBlock class | class := Object subclass: #CrashTestDummy instanceVariableNames: 'instVar' classVariableNames: '' poolDictionaries: '' category: 'Crash-Test'. class compile:'instVar: value instVar := value'. class compile:'crashingBlock ^[instVar]'. crashingBlock := (class new) instVar: 42; crashingBlock. Object subclass: #CrashTestDummy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Crash-Test'. crashingBlock value"! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEprimitive (in category 'method prototypes') ----- CompiledMethodPROTOTYPEprimitive "Answer the primitive index associated with the receiver. Zero indicates that this is not a primitive method." | initialPC | ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?" ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)] ifFalse: [0]! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod:header: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod: numberOfBytes header: headerWord "This newMethod:header: gets sent after handleFailingBasicNew: has done a full garbage collection and possibly grown memory. If this basicNew: fails then the system really is low on space, so raise the OutOfMemory signal. Primitive. Answer an instance of this class with the number of indexable variables specified by the argument, headerWord, and the number of bytecodes specified by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes is negative, or if the receiver is not a CompiledMethod class, or if there is not enough memory available. Essential. See Object documentation whatIsAPrimitive." <primitive: 79> "space must be low." OutOfMemory signal. "retry if user proceeds" ^self newMethod: numberOfBytes header: headerWord! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEhandleFailingNewMethod:header: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEhandleFailingNewMethod: numberOfBytes header: headerWord "This newMethod:header: gets sent after newMethod:header: has failed and allowed a scavenging garbage collection to occur. The scavenging collection will have happened as the VM is activating the (failing) basicNew:. If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient space and a global garbage collection is required. Retry after garbage collecting and growing memory if necessary. Primitive. Answer an instance of this class with the number of indexable variables specified by the argument, headerWord, and the number of bytecodes specified by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes is negative, or if the receiver is not a CompiledMethod class, or if there is not enough memory available. Essential. See Object documentation whatIsAPrimitive." <primitive: 79> | bytesRequested | bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16. Smalltalk garbageCollect < bytesRequested ifTrue: [Smalltalk growMemoryByAtLeast: bytesRequested]. "retry after global garbage collect and possible grow" ^self handleFailingFailingNewMethod: numberOfBytes header: headerWord! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder <indirect>! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinitialize (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEinitialize "CompiledMethod initialize" <indirect>! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass <indirect>! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: aBytecodeEncoderSubclass <indirect>! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex "Since this method refers to ClassVariables things are easier if it lives in the actual class." <indirect>! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag "Since this method refers to ClassVariables things are easier if it lives in the actual class." <indirect>! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewMethod:header: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEnewMethod: numberOfBytes header: headerWord "Primitive. Answer an instance of me. The number of literals (and other information) is specified by the headerWord (see my class comment). The first argument specifies the number of fields for bytecodes in the method. Fail if either argument is not a SmallInteger, or if numberOfBytes is negative, or if memory is low. Once the header of a method is set by this primitive, it cannot be changed to change the number of literals. Essential. See Object documentation whatIsAPrimitive." <primitive: 79 error: ec> ec == #'insufficient object memory' ifTrue: [^self handleFailingNewMethod: numberOfBytes header: headerWord]. ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnConstant:trailerBytes: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEtoReturnConstant: index trailerBytes: trailer "Answer an instance of me that is a quick return of the constant indexed in (true false nil -1 0 1 2)." ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnField:trailerBytes: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEtoReturnField: field trailerBytes: trailer "Answer an instance of me that is a quick return of the instance variable indexed by the argument, field." ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field! Item was changed: ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: (in category 'method prototypes') ----- CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: trailer "Answer an instance of me that is a quick return of the instance (^self)." ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256! Item was changed: ----- Method: SpurBootstrapPrototypes>>EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') ----- EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex <remove>! Item was changed: ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: (in category 'method prototypes') ----- EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: primitiveIndex "Since this method has inst var refs the prototype must live in the actual class." <indirect>! Item was changed: ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: (in category 'method prototypes') ----- EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: bytecode "Answer the number of bytes in the bytecode." bytecode <= 125 ifTrue: [^1]. bytecode >= 176 ifTrue: [^1]. bytecode >= 160 ifTrue: "long jumps" [^2]. bytecode >= 144 ifTrue: "short jumps" [^1]. "extensions" bytecode >= 128 ifTrue: [^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127]. ^nil! Item was changed: ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode (in category 'method prototypes') ----- EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)" ^139! Item was changed: ----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEbasicNew (in category 'method prototypes') ----- FloatclassPROTOTYPEbasicNew ^BoxedFloat64 basicNew: 2! Item was changed: ----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEbasicNew: (in category 'method prototypes') ----- FloatclassPROTOTYPEbasicNew: anInteger ^BoxedFloat64 basicNew: 2! Item was changed: ----- Method: SpurBootstrapPrototypes>>InstructionClientPROTOTYPEcallPrimitive: (in category 'method prototypes') ----- InstructionClientPROTOTYPEcallPrimitive: pimIndex "V3PlusClosures: 139 10001011 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256) NewsqueakV4: 249 11111001 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256) SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + ( jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."! Item was changed: ----- Method: SpurBootstrapPrototypes>>MethodNodeOLDSQUEAKPROTOTYPEgenerate: (in category 'method prototypes') ----- MethodNodeOLDSQUEAKPROTOTYPEgenerate: trailer "The receiver is the root of a parse tree. Answer a CompiledMethod. The argument, trailer, is arbitrary but is typically either the reference to the source code that is stored with every CompiledMethod, or an encoding of the method's temporary names." ^self generate: trailer using: CompiledMethod! Item was changed: ----- Method: SpurBootstrapPrototypes>>MethodNodePROTOTYPEgenerate:using: (in category 'method prototypes') ----- MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass "Since this method has inst var refs the prototype must live in the actual class." <indirect>! Item was changed: ----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEasCharacter (in category 'method prototypes') ----- SmallIntegerPROTOTYPEasCharacter <primitive: 170> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEcompactClassesArray (in category 'method prototypes') ----- SmalltalkImagePROTOTYPEcompactClassesArray "Smalltalk compactClassesArray" "Backward-compatibility support. Spur does not have compact classes." ^{}! Item was changed: ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') ----- SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: numBytes "Grow memory by at least the requested number of bytes. Primitive. Essential. Fail if no memory is available." <primitive: 180> (numBytes isInteger and: [numBytes > 0]) ifTrue: [OutOfMemory signal]. ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEmaxIdentityHash (in category 'method prototypes') ----- SmalltalkImagePROTOTYPEmaxIdentityHash "Answer the maximum identityHash value supported by the VM." <primitive: 176> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>SpaceTallyPROTOTYPEspaceForInstancesOf: (in category 'method prototypes') ----- SpaceTallyPROTOTYPEspaceForInstancesOf: aClass "Answer a pair of the number of bytes consumed by all instances of the given class, including their object headers, and the number of instances." | instances total | instances := aClass allInstances. instances isEmpty ifTrue: [^#(0 0)]. total := 0. aClass isVariable ifTrue: [instances do: [:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]] ifFalse: [total := instances size * aClass byteSizeOfInstance]. ^{ total. instances size }! Item was changed: ----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') ----- SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: numBytes "Grow memory by at least the requested number of bytes. Primitive. Fail if no memory is available. Essential." <primitive: 180> ^(numBytes isInteger and: [numBytes > 0]) ifTrue: [OutOfMemory signal] ifFalse: [self primitiveFailed]! Item was changed: ----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEmaxIdentityHash (in category 'method prototypes') ----- SystemDictionaryPROTOTYPEmaxIdentityHash "Answer the maximum identityHash value supported by the VM." <primitive: 176> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjects (in category 'method prototypes') ----- SystemNavigationPROTOTYPEallObjects "Answer an Array of all objects in the system. Fail if there isn't enough memory to instantiate the result." <primitive: 178> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjectsDo: (in category 'method prototypes') ----- SystemNavigationPROTOTYPEallObjectsDo: aBlock "Evaluate the argument, aBlock, for each object in the system, excluding immediates such as SmallInteger and Character." self allObjectsOrNil ifNotNil: [:allObjects| allObjects do: aBlock] ifNil: ["Fall back on the old single object primitive code. With closures, this needs to use an end marker (lastObject) since activation of the block will create new contexts and cause an infinite loop. The lastObject must be created before calling someObject, so that the VM can settle the enumeration (e.g. by flushing new space) as a side effect of someObject" | object lastObject | lastObject := Object new. object := self someObject. [lastObject == object or: [0 == object]] whileFalse: [aBlock value: object. object := object nextObject]]! Item was changed: ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjectsOrNil (in category 'method prototypes') ----- SystemNavigationPROTOTYPEallObjectsOrNil "Answer an Array of all objects in the system. Fail if there isn't enough memory to instantiate the result and answer nil." <primitive: 178> ^nil! Item was changed: ----- Method: SpurBootstrapPrototypes>>WideStringPROTOTYPEat: (in category 'method prototypes') ----- WideStringPROTOTYPEat: index "Answer the Character stored in the field of the receiver indexed by the argument. Primitive. Fail if the index argument is not an Integer or is out of bounds. Essential. See Object documentation whatIsAPrimitive." <primitive: 63> ^index isInteger ifTrue: [self errorSubscriptBounds: index] ifFalse: [index isNumber ifTrue: [self at: index asInteger] ifFalse: [self errorNonIntegerIndex]]! Item was changed: ----- Method: SpurBootstrapPrototypes>>WideStringPROTOTYPEat:put: (in category 'method prototypes') ----- WideStringPROTOTYPEat: index put: aCharacter "Store the Character into the field of the receiver indicated by the index. Primitive. Fail if the index is not an Integer or is out of bounds, or if the argument is not a Character. Essential. See Object documentation whatIsAPrimitive." <primitive: 64> ^aCharacter isCharacter ifTrue: [index isInteger ifTrue: [self errorSubscriptBounds: index] ifFalse: [self errorNonIntegerIndex]] ifFalse: [self errorImproperStore]! Item was added: + ----- Method: SpurBootstrapPrototypes>>categoryForClass:meta:selector: (in category 'method prototype categorization') ----- + categoryForClass: className meta: isMeta selector: selector + ^(isMeta + ifTrue: [{ className. #class. selector }] + ifFalse: [{ className. selector }]) + caseOf: { + [#(Behavior allInstancesOrNil)] -> [#enumerating]. + [#(Behavior byteSizeOfInstance)] -> [#'accessing instances and variables']. + [#(Behavior byteSizeOfInstanceOfSize:)] -> [#'accessing instances and variables']. + [#(Behavior elementSize)] -> [#'accessing instances and variables']. + [#(Behavior handleFailingBasicNew)] -> [#private]. + [#(Behavior handleFailingBasicNew:)] -> [#private]. + [#(Behavior handleFailingFailingBasicNew)] -> [#private]. + [#(Behavior handleFailingFailingBasicNew:)] -> [#private]. + [#(Behavior identityHash)] -> [#comparing]. + [#(Behavior isEphemeronClass)] -> [#testing]. + [#(Behavior isImmediateClass)] -> [#testing]. + [#(Character identityHash)] -> [#comparing]. + [#(Class immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)] + -> [#'subclass creation']. + [#(ClassBuilder superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)] + -> [#public]. + [#(CompiledMethod class handleFailingFailingNewMethod:header:)] + -> [#private]. + [#(CompiledMethod class handleFailingNewMethod:header:)] + -> [#private]. + [#(Context class allInstances)] -> [#enumerating]. + [#(Context class allInstancesDo:)] -> [#enumerating]. + [#(Context failPrimitiveWith:)] -> [#'system simulation']. + [#(Context isPrimFailToken:)] -> [#private]. + [#(Context send:to:with:lookupIn:)] -> [#controlling]. + [#(Context isPrimFailToken:)] -> [#private]. + [#(Context send:to:with:lookupIn:)] -> [#controlling]. + [#(CompiledMethod class headerFlagForEncoder:)] + -> [#'method encoding']. + [#(CompiledMethod class installPrimaryBytecodeSet:)] + -> [#'class initialization']. + [#(CompiledMethod class installSecondaryBytecodeSet:)] + -> [#'class initialization']. + [#(EncoderForV3PlusClosures genCallPrimitive:)] + -> [#'bytecode generation']. + [#(EncoderForV3PlusClosures class callPrimitiveCode)] + -> [#'bytecode decoding']. + [#(Context failPrimitiveWith:)] -> [#'system simulation']. + [#(Context class allInstances)] -> [#enumerating]. + [#(Context class allInstancesDo:)] -> [#enumerating]. + [#(SmallInteger asCharacter)] -> [#converting]. + [#(SmalltalkImage growMemoryByAtLeast:)] -> [#'memory space']. + [#(SmalltalkImage maxIdentityHash)] -> [#'system attributes']. + [#(SystemDictionary growMemoryByAtLeast:)] -> [#'memory space']. + [#(SystemDictionary maxIdentityHash)] -> [#'system attributes']. + [#(SystemDictionary setGCParameters)] -> [#'snapshot and quit']. + [#(SystemNavigation allObjects)] -> [#query]. + [#(SystemNavigation allObjectsOrNil)] -> [#query]. + } + otherwise: + [Transcript nextPutAll: className. + isMeta ifTrue: [Transcript nextPutAll: ' class']. + Transcript nextPutAll: '>>'; store: selector; nextPutAll: ' is unclassified'; cr; flush. + ^Categorizer default]! Item was changed: ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEinterpretExtension:in:for: (in category 'method prototypes') ----- InstructionStreamPROTOTYPEinterpretExtension: offset in: method for: client ^self interpretV3ClosuresExtension: offset in: method for: client! Item was changed: ----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') ----- ClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex "Compute the new format for making oldClass a subclass of newSuper. Answer the format or nil if there is any problem." | instSize isVar isWords isPointers isWeak | type == #compiledMethod ifTrue: [newInstSize > 0 ifTrue: [self error: 'A compiled method class cannot have named instance variables'. ^nil]. ^CompiledMethod format]. instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]). instSize > 65535 ifTrue: [self error: 'Class has too many instance variables (', instSize printString,')'. ^nil]. type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true]. type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false]. type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false]. type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false]. type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true]. type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true]. type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true]. (isPointers not and: [instSize > 0]) ifTrue: [self error: 'A non-pointer class cannot have named instance variables'. ^nil]. ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak! Item was changed: ----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') ----- ClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: is32BitWords pointers: isPointers weak: isWeak "Compute the format for the given instance specfication. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 = unused 7 = immediates (SmallInteger, Character) 8 = unused 9 = reserved for 64-bit indexable 10-11 = 32-bit indexable (Bitmap) 12-15 = 16-bit indexable 16-23 = 8-bit indexable 24-31 = compiled methods (CompiledMethod)" | instSpec | instSpec := isWeak ifTrue: [isVar ifTrue: [4] ifFalse: [5]] ifFalse: [isPointers ifTrue: [isVar ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]] ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]] ifFalse: [isVar ifTrue: [is32BitWords ifTrue: [10] ifFalse: [16]] ifFalse: [7]]]. ^(instSpec bitShift: 16) + nInstVars! Item was changed: ----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') ----- ClassBuilderPROTOTYPEsuperclass: aClass immediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new immediate class as a subclass of an existing class." | env | aClass instSize > 0 ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields']. aClass isVariable ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables']. aClass isPointers ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields']. "Cope with pre-environment and environment versions. Simplify asap." env := (Smalltalk classNamed: #EnvironmentRequest) ifNil: [aClass environment] ifNotNil: [:erc| erc signal ifNil: [aClass environment]]. ^self name: t inEnvironment: env subclassOf: aClass type: #immediate instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat! Item was changed: ----- Method: SpurBootstrapSqueakFamilyPrototypes>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') ----- ClassBuilderPROTOTYPEupdate: oldClass to: newClass "Convert oldClass, all its instances and possibly its meta class into newClass, instances of newClass and possibly its meta class. The process is surprisingly simple in its implementation and surprisingly complex in its nuances and potentially bad side effects. We can rely on two assumptions (which are critical): #1: The method #updateInstancesFrom: will not create any lasting pointers to 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do a become of the old vs. the new instances and therefore it will not create pointers to *new* instances before the #become: which are *old* afterwards) #2: The non-preemptive execution of the critical piece of code guarantees that nobody can get a hold by 'other means' (such as process interruption and reflection) on the old instances. Given the above two, we know that after #updateInstancesFrom: there are no pointers to any old instances. After the forwarding become there will be no pointers to the old class or meta class either. Andreas Raab, 2/27/2003 23:42" | meta | meta := oldClass isMeta. "Note: Everything from here on will run without the ability to get interrupted to prevent any other process to create new instances of the old class." ["Note: The following removal may look somewhat obscure and needs an explanation. When we mutate the class hierarchy we create new classes for any existing subclass. So it may look as if we don't have to remove the old class from its superclass. However, at the top of the hierarchy (the first class we reshape) that superclass itself is not newly created so therefore it will hold both the oldClass and newClass in its (obsolete or not) subclasses. Since the #become: below will transparently replace the pointers to oldClass with newClass the superclass would have newClass in its subclasses TWICE. With rather unclear effects if we consider that we may convert the meta-class hierarchy itself (which is derived from the non-meta class hierarchy). Due to this problem ALL classes are removed from their superclass just prior to converting them. Here, breaking the superclass/subclass invariant really doesn't matter since we will effectively remove the oldClass (becomeForward:) just a few lines below." oldClass superclass removeSubclass: oldClass. oldClass superclass removeObsoleteSubclass: oldClass. "make sure that the VM cache is clean" oldClass methodDict do: [:cm | cm flushCache]. "Convert the instances of oldClass into instances of newClass" newClass updateInstancesFrom: oldClass. meta ifTrue: [oldClass becomeForward: newClass. oldClass updateMethodBindingsTo: oldClass binding] ifFalse: [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}. oldClass updateMethodBindingsTo: oldClass binding. oldClass class updateMethodBindingsTo: oldClass class binding]. "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was to ensure no old instances existed after the becomeForward:. Without the GC it was possible to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward: updated references from the old objects to new objects but didn't destroy the old objects. But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."] valueUnpreemptively! Item was changed: ----- Method: SpurBootstrapSqueakFamilyPrototypes>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') ----- InstructionPrinterPROTOTYPEcallPrimitive: index "Print the callPrimitive." self print: 'callPrimtive: ' , index printString! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>BehaviorPROTOTYPEidentityHash (in category 'method prototypes') ----- BehaviorPROTOTYPEidentityHash "Answer a SmallInteger whose value is related to the receiver's identity. Behavior implements identityHash to allow the VM to use an object representation which does not include a direct reference to an object's class in an object. If the VM is using this implementation then classes are held in a class table and instances contain the index of their class in the table. A class's class table index is its identityHash so that an instance can be created without searching the table for a class's index. The VM uses this primitive to enter the class into the class table, assigning its identityHash with an as yet unused class table index. If this primitive fails it means that the class table is full. In Spur as of 2014 there are 22 bits of classTable index and 22 bits of identityHash per object. Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive." <primitive: 175> self primitiveFailed! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>CharacterPROTOTYPEclone (in category 'method prototypes') ----- CharacterPROTOTYPEclone "Answer the receiver, because Characters are unique." ^self! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') ----- ClassPROTOTYPEimmediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new immediate class as a subclass of an existing class (the receiver)." ^ClassBuilder new superclass: self immediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEsend:to:with:super: (in category 'method prototypes') ----- ContextPartPROTOTYPEsend: selector to: rcvr with: arguments super: superFlag "Simulate the action of sending a message with selector arguments to rcvr. The argument, superFlag, tells whether the receiver of the message was specified with 'super' in the source method." ^self send: selector to: rcvr with: arguments lookupIn: (superFlag ifTrue: [self method methodClassAssociation value superclass] ifFalse: [self objectClass: rcvr])! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEtryNamedPrimitiveIn:for:withArgs: (in category 'method prototypes') ----- ContextPartPROTOTYPEtryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments "Invoke the named primitive for aCompiledMethod, answering its result, or, if the primiitve fails, answering the error code." <primitive: 218 error: ec> ec ifNotNil: ["If ec is an integer other than -1 there was a problem with primitive 218, not with the external primitive itself. -1 indicates a generic failure (where ec should be nil) but ec = nil means primitive 218 is not implemented. So interpret -1 to mean the external primitive failed with a nil error code." ec isInteger ifTrue: [ec = -1 ifTrue: [ec := nil] ifFalse: [self primitiveFailed]]]. ^self class primitiveFailTokenFor: ec! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') ----- IntegerclassPROTOTYPEinitialize "Integer initialize" self initializeLowBitPerByteTable! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextclassPROTOTYPEallInstances (in category 'method prototypes') ----- MethodContextclassPROTOTYPEallInstances "Answer all instances of the receiver." <primitive: 177> "The primitive can fail because memory is low. If so, fall back on the old enumeration code, which gives the system a chance to GC and/or grow. Because aBlock might change the class of inst (for example, using become:), it is essential to compute next before aBlock value: inst. Only count until thisContext since this context has been created only to compute the existing instances." | inst insts next | insts := WriteStream on: (Array new: 64). inst := self someInstance. [inst == thisContext or: [inst == nil]] whileFalse: [next := inst nextInstance. insts nextPut: inst. inst := next]. ^insts contents! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') ----- MethodContextclassPROTOTYPEallInstancesDo: aBlock "Evaluate aBlock with each of the current instances of the receiver." | instances inst next | instances := self allInstancesOrNil. instances ifNotNil: [instances do: aBlock. ^self]. "allInstancesOrNil can fail because memory is low. If so, fall back on the old enumeration code. Because aBlock might change the class of inst (for example, using become:), it is essential to compute next before aBlock value: inst. Only count until thisContext since evaluation of aBlock will create new contexts." inst := self someInstance. [inst == thisContext or: [inst == nil]] whileFalse: [next := inst nextInstance. aBlock value: inst. inst := next]! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes') ----- ProtoObjectPROTOTYPEscaledIdentityHash "For identityHash values returned by primitive 75, answer such values times 2^8. Otherwise, match the existing identityHash implementation" ^self identityHash * 256 "bitShift: 8"! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes') ----- SmalltalkImagePROTOTYPEsetGCParameters "Adjust the VM's default GC parameters to avoid too much tenuring. Maybe this should be left to the VM?" | proportion edenSize survivorSize averageObjectSize numObjects | proportion := 0.9. "tenure when 90% of pastSpace is full" edenSize := SmalltalkImage current vmParameterAt: 44. survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)" averageObjectSize := 8 * self wordSize. "a good approximation" numObjects := (proportion * survivorSize / averageObjectSize) rounded. SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"! Item was changed: ----- Method: SpurBootstrapSqueakPrototypes>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes') ----- SystemDictionaryPROTOTYPEsetGCParameters "Adjust the VM's default GC parameters to avoid too much tenuring. Maybe this should be left to the VM?" | proportion edenSize survivorSize averageObjectSize numObjects | proportion := 0.9. "tenure when 90% of pastSpace is full" edenSize := SmalltalkImage current vmParameterAt: 44. survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)" averageObjectSize := 8 * self wordSize. "a good approximation" numObjects := (proportion * survivorSize / averageObjectSize) rounded. SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!

1 0

VM Maker: VMMaker.oscog-eem.1036.mcz
by commits＠source.squeak.org 04 Feb '15

04 Feb '15

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1036.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.1036 Author: eem Time: 3 February 2015, 6:54:57.116 pm UUID: d4ac012e-2503-42d2-a8c1-e73dd59b48eb Ancestors: VMMaker.oscog-eem.1035 Eliminate NewspeakV3 support from the Newspeak Spur VMs. Fix commonSendAbsent's comment. Don't expunge unmarked entries from the class table in the segment storage markObjects: invocation. Use numSlotsOfAny: to avoid unnecessary assert fails in some printing & testing code. Fix ... bug in longPrintOop: Simulate primitiveDirectoryCreate Fix missing supersend init bug in the DeflatePlugin. =============== Diff against VMMaker.oscog-eem.1035 =============== Item was changed: ----- Method: Cogit class>>initializeBytecodeTable (in category 'class initialization') ----- initializeBytecodeTable "SimpleStackBasedCogit initializeBytecodeTableWith: Dictionary new" "StackToRegisterMappingCogit initializeBytecodeTableWith: Dictionary new" (initializationOptions at: #bytecodeTableInitializer ifAbsent: nil) ifNotNil: [:initalizer| ^self perform: initalizer]. NewspeakVM ifTrue: + [^(initializationOptions at: #SpurObjectMemory ifAbsent: false) + ifTrue: + [MULTIPLEBYTECODESETS + ifTrue: [self initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid] + ifFalse: [self initializeBytecodeTableForNewspeakV4]] + ifFalse: + [MULTIPLEBYTECODESETS + ifTrue: [self initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid] + ifFalse: [self initializeBytecodeTableForNewspeakV3PlusClosures]]]. - [^MULTIPLEBYTECODESETS - ifTrue: [self initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid] - ifFalse: [self initializeBytecodeTableForNewspeakV3PlusClosures]]. ^self initializeBytecodeTableForSqueakV3PlusClosures! Item was added: + ----- Method: Cogit class>>initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid (in category 'class initialization') ----- + initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid + "SimpleStackBasedCogit initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid" + "StackToRegisterMappingCogit initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid" + + | v3Table v4Table | + "N.B. Must do it backwards to evaluate AltBlockCreationBytecodeSize & BlockCreationBytecodeSize et al correctly." + self initializeBytecodeTableForNewspeakV4. + v4Table := generatorTable. + AltBlockCreationBytecodeSize := BlockCreationBytecodeSize. + AltNSSendIsPCAnnotated := NSSendIsPCAnnotated. + AltFirstSpecialSelector := FirstSpecialSelector. + self initializeBytecodeTableForSqueakV3PlusClosures. + v3Table := generatorTable. + generatorTable := CArrayAccessor on: v3Table object, v4Table object! Item was changed: ----- Method: DeflatePlugin>>initialize (in category 'initialize-release') ----- initialize + writeStreamInstSize := 0. + super initialize! - writeStreamInstSize := 0! Item was changed: ----- Method: FilePlugin>>primitiveDirectoryCreate (in category 'directory primitives') ----- primitiveDirectoryCreate | dirName dirNameIndex dirNameSize okToCreate | <var: #dirNameIndex type: 'char *'> <export: true> dirName := interpreterProxy stackValue: 0. + (interpreterProxy isBytes: dirName) ifFalse: + [^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: dirName) - ifFalse: [^interpreterProxy primitiveFail]. dirNameIndex := interpreterProxy firstIndexableField: dirName. dirNameSize := interpreterProxy byteSizeOf: dirName. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" + sCCPfn ~= 0 ifTrue: + [okToCreate := self cCode: ' ((sqInt (*)(char *, sqInt))sCCPfn)(dirNameIndex, dirNameSize)' + inSmalltalk: [true]. + okToCreate ifFalse: + [^interpreterProxy primitiveFail]]. - sCCPfn ~= 0 - ifTrue: [okToCreate := self cCode: ' ((sqInt (*)(char *, sqInt))sCCPfn)(dirNameIndex, dirNameSize)'. - okToCreate - ifFalse: [^interpreterProxy primitiveFail]]. (self + cCode: 'dir_Create(dirNameIndex, dirNameSize)' + inSmalltalk: [self createDirectory: (interpreterProxy asString: dirNameIndex)]) ifFalse: + [^interpreterProxy primitiveFail]. - cCode: 'dir_Create(dirNameIndex, dirNameSize)' - inSmalltalk: [false]) - ifFalse: [^interpreterProxy primitiveFail]. interpreterProxy pop: 1! Item was added: + ----- Method: FilePluginSimulator>>createDirectory: (in category 'simulation') ----- + createDirectory: aString + ^[FileDirectory default primCreateDirectory: aString. + true] + on: Error + do: [:ex| false] + ! Item was added: + ----- Method: ObjectMemory>>numSlotsOfAny: (in category 'object access') ----- + numSlotsOfAny: obj + "Sput compatibility" + ^self numSlotsOf: obj! Item was changed: ----- Method: Spur64BitMMLESimulator>>longAt:put: (in category 'memory access') ----- + longAt: byteAddress put: a64BitValue - longAt: byteAddress put: a32BitValue "Store the 64-bit value at byteAddress which must be 0 mod 4." "byteAddress = 16r1F5AE8 ifTrue: [self halt]." + ^self long64At: byteAddress put: a64BitValue! - ^self long64At: byteAddress put: a32BitValue! Item was changed: ----- Method: SpurMemoryManager>>markAndTraceClassOf: (in category 'gc - global') ----- markAndTraceClassOf: objOop "Ensure the class of the argument is marked, pushing it on the markStack if not already marked. - Also set the relevant bit in the classTableBitmap so that duplicate entries can be eliminated. And for one-way become, which can create duplicate entries in the class table, make sure objOop's classIndex refers to the classObj's actual classIndex. Note that this is recursive, but the metaclass chain should terminate quickly." <inline: false> | classIndex classObj realClassIndex | classIndex := self classIndexOf: objOop. classObj := self classOrNilAtIndex: classIndex. + self assert: (coInterpreter objCouldBeClassObj: classObj). realClassIndex := self rawHashBitsOf: classObj. classIndex ~= realClassIndex ifTrue: [self setClassIndexOf: objOop to: realClassIndex]. (self isMarked: classObj) ifFalse: [self setIsMarkedOf: classObj to: true. self markAndTraceClassOf: classObj. self push: classObj onObjStack: markStack]! Item was changed: ----- Method: SpurMemoryManager>>markObjects: (in category 'gc - global') ----- + markObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged - markObjects: objectsShouldBeUnmarked <inline: #never> "for profiling" + "Mark all accessible objects. objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged + is true if all objects are unmarked and/or if unmarked classes shoud be removed from the class table." - "Mark all accessible objects. " "If the incremental collector is running mark bits may be set; stop it and clear them if necessary." self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'marking...'; flush]. self runLeakCheckerForFullGC: true. + self shutDownIncrementalGC: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged. - self shutDownIncrementalGC: objectsShouldBeUnmarked. self initializeUnscannedEphemerons. self initializeMarkStack. self initializeWeaklingStack. self markAccessibleObjectsAndFireEphemerons. + self expungeDuplicateAndUnmarkedClasses: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged. - self expungeDuplicateAndUnmarkedClasses: true. self nilUnmarkedWeaklingSlots! Item was changed: ----- Method: SpurMemoryManager>>restoreObjectsIn:savedHashes: (in category 'image segment in/out') ----- restoreObjectsIn: objArray savedHashes: savedHashes + "Enumerate the objects in objArray, unmarking them and restoring their hashes - "Enumerate the objects in objArray,unmarking them and restoring their hashes from the corresponding 32-bit slots in savedHashes. The first unused entry in objArray will have a non-hash value entry in savedHashes. Free savedHashes." <inline: false> 0 to: (self numSlotsOf: objArray) - 1 do: [:i| | hash oop | (hash := self fetchLong32: i ofObject: savedHashes) > self maxIdentityHash ifTrue: [(self isInOldSpace: savedHashes) ifTrue: [self freeObject: savedHashes]. ^self]. oop := self fetchPointer: i ofObject: objArray. self setHashBitsOf: oop to: hash. self setIsMarkedOf: oop to: false]. (self isInOldSpace: savedHashes) ifTrue: [self freeObject: savedHashes]! Item was changed: ----- Method: SpurMemoryManager>>storeImageSegmentInto:outPointers:roots: (in category 'image segment in/out') ----- storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots "This primitive is called from Squeak as... <imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray. This primitive will store a binary image segment (in the same format as objercts in the heap) of the set of objects in arrayOfObjects. All pointers from within the set to objects outside the set will be copied into the array of outPointers. In their place in the image segment will be an oop equal to the offset in the outPointer array (the first would be 4). but with the high bit set. Since Spur has a class table the load primitive must insert classes that have instances in the class table. This primitive marks such classes using the isRemembered bit, which isn't meaningful as a remembered bit in the segment. The primitive expects the segmentWordArray and outPointerArray to be more than adequately long. In this case it returns normally, and truncates the two arrays to exactly the right size. The primitive can fail for the following reasons with the specified failure codes: PrimErrWritePastObject: the segmentWordArray is too small PrimErrBadIndex: the outPointerArray is too small PrimErrNoMemory: additional allocations failed PrimErrLimitExceeded: there is no room in the hash field to store object oops." <inline: false> | arrayOfObjects savedInHashes savedOutHashes fillValue segStart segAddr endSeg outIndex | self leakCheckImageSegments ifTrue: [self runLeakCheckerForFullGC: true]. "First compute the transitive closure, collecting the sequence of objects to be stored in the arrayOfObjects array." arrayOfObjects := self objectsReachableFromRoots: arrayOfRoots. arrayOfObjects ifNil: [^PrimErrNoMemory]. self assert: self allObjectsUnmarked. "work to be done when the incremental GC is written" "The scheme is to copy the objects into segmentWordArray, and then map the oops in sementWordArray. Therefore the primitive needs to both map efficiently originals to copies in segmentWordArray and be able to undo any side-effects if the primitive fails because either sementWordArray or outPointerArray is too small. The mapping is done by having the originals (either the objects in arrayOfObjects or the objects in outPointerArray) refer to their mapped locations through their identityHash, and saving their identityHashes in two ByteArrays, one that mirrors arrayOfObjects, and one that mirrors outPointerArray. Since arrayOfObjects and its saved hashes, and outPointerArray and its saved hashes, can be enumerated side-by-side, the hashes can be restored to the originals. So the hash of an object in arrayOfObjects is set to its offset in segmentWordArray / self allocationUnit, and the hash of an object in outPointerArray is set to its index in outPointerArray plus the top hash bit. Oops in segmentWordArray are therefore mapped by accessing the original oop's identityHash, testing the bottom bit to distinguish between internal and external oops. The saved hash arrays are initialized with an out-of-range hash value so that the first unused entry can be identified." savedInHashes := self allocateSlots: (self numSlotsForBytes: (self numSlotsOf: arrayOfObjects) * 4) format: self firstLongFormat classIndex: self thirtyTwoBitLongsClassIndexPun. savedOutHashes := self allocateSlots: (self numSlotsForBytes: (self numSlotsOf: outPointerArray) * 4) format: self firstLongFormat classIndex: self thirtyTwoBitLongsClassIndexPun. (savedInHashes isNil or: [savedOutHashes isNil]) ifTrue: [self freeObject: arrayOfObjects. ^PrimErrNoMemory]. fillValue := self wordSize = 4 ifTrue: [self maxIdentityHash + 1] ifFalse: [self maxIdentityHash + 1 << 32 + (self maxIdentityHash + 1)]. self fillObj: savedInHashes numSlots: (self numSlotsOf: savedInHashes) with: fillValue. self fillObj: savedOutHashes numSlots: (self numSlotsOf: savedOutHashes) with: fillValue. "Both to expand the max size of segment and to reduce the length of the load-time pass that adds classes to the class table, move classes to the front of arrayOfObjects, leaving the root array as the first element." self moveClassesForwardsIn: arrayOfObjects. segAddr := segmentWordArray + self baseHeaderSize. endSeg := self addressAfter: segmentWordArray. "Write a version number for byte order and version check." segAddr >= endSeg ifTrue: [^PrimErrGenericFailure]. self long32At: segAddr put: self imageSegmentVersion. self long32At: segAddr + 4 put: self imageSegmentVersion. segStart := segAddr := segAddr + self allocationUnit. "Copy all reachable objects to the segment." 0 to: (self numSlotsOf: arrayOfObjects) - 1 do: [:i| | newSegAddrOrError objOop | objOop := self fetchPointer: i ofObject: arrayOfObjects. self deny: ((self isImmediate: objOop) or: [self isForwarded: objOop]). self storeLong32: i ofObject: savedInHashes withValue: (self rawHashBitsOf: objOop). newSegAddrOrError := self copyObj: objOop toAddr: segAddr startAt: segStart stopAt: endSeg. newSegAddrOrError < segStart ifTrue: [^self return: newSegAddrOrError restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes and: outPointerArray savedHashes: savedOutHashes]. segAddr := newSegAddrOrError]. "Check that it can be safely shortened." (endSeg ~= segAddr and: [endSeg - segAddr < (self baseHeaderSize + self bytesPerOop)]) ifTrue: [^self return: PrimErrWritePastObject restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes and: outPointerArray savedHashes: savedOutHashes]. "Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects have their hashes set to point to their copies in segmentWordArray." (outIndex := self mapOopsFrom: segStart to: segAddr outPointers: outPointerArray outHashes: savedOutHashes) < 0 ifTrue: "no room in outPointers; fail" [^self return: PrimErrBadIndex restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes and: outPointerArray savedHashes: savedOutHashes]. + "We're done. Shorten the results, restore hashes and return." - "We're done. SHorten the results, restore hashes and return." self shorten: segmentWordArray toIndexableSize: segAddr - (segmentWordArray + self baseHeaderSize) / 4. self shorten: outPointerArray toIndexableSize: outIndex. ^self return: PrimNoErr restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes and: outPointerArray savedHashes: savedOutHashes! Item was added: + ----- Method: SpurMemoryManager>>superclassOf: (in category 'simulation only') ----- + superclassOf: classPointer + "hack around the CoInterpreter/ObjectMemory split refactoring" + <doNotGenerate> + ^coInterpreter superclassOf: classPointer! Item was changed: ----- Method: StackInterpreter class>>initializeBytecodeTable (in category 'initialization') ----- initializeBytecodeTable "StackInterpreter initializeBytecodeTable" (initializationOptions at: #bytecodeTableInitializer ifAbsent: nil) ifNotNil: [:initalizer| ^self perform: initalizer]. NewspeakVM ifTrue: + [^(initializationOptions at: #SpurObjectMemory ifAbsent: false) + ifTrue: + [MULTIPLEBYTECODESETS + ifTrue: [self initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid] + ifFalse: [self initializeBytecodeTableForNewspeakV4]] + ifFalse: + [MULTIPLEBYTECODESETS + ifTrue: [self initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid] + ifFalse: [self initializeBytecodeTableForNewspeakV3PlusClosures]]]. - [^MULTIPLEBYTECODESETS - ifTrue: [self initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid] - ifFalse: [self initializeBytecodeTableForNewspeakV3PlusClosures]]. ^self initializeBytecodeTableForSqueakV3PlusClosures! Item was added: + ----- Method: StackInterpreter class>>initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid (in category 'initialization') ----- + initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid + "StackInterpreter initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid" + + | v3Table v4Table | + self initializeBytecodeTableForNewspeakV4. + v4Table := BytecodeTable. + AltBytecodeEncoderClassName := BytecodeEncoderClassName. + AltLongStoreBytecode := LongStoreBytecode. + self initializeBytecodeTableForSqueakV3PlusClosures. + v3Table := BytecodeTable. + BytecodeTable := v3Table, v4Table! Item was changed: ----- Method: StackInterpreter>>commonSendAbsent (in category 'send bytecodes') ----- commonSendAbsent "Send an absent receiver message, shuffling arguments and inserting the absent receiver for the send. Assume: messageSelector and argumentCount have been set, and that the arguments but not the receiver have been pushed onto the stack," "Note: This method is inlined into the interpreter dispatch loop." + "160-175 1010 i i i i Send To Absent Implicit Receiver Literal Selector #iiii With 0 Arguments" - "160-175 1010 i i i i Send To Absent Implicit Receiver Literal Selector #iiii With 0 Arguments" "240 11110000 i i i i i j j j Send To Absent Implicit Receiver Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments" + "245 11110101 i i i i i j j j Send To Self Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments" + "254 11111110 i i i i i j j j kkkkkkkk Send To Enclosing Object at Depth kkkkkkkk Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments" <sharedCodeInCase: #extSendAbsentImplicitBytecode> self shuffleArgumentsAndStoreAbsentReceiver: localAbsentReceiver. lkupClassTag := objectMemory fetchClassTagOf: localAbsentReceiver. self assert: (objectMemory classForClassTag: lkupClassTag) ~= objectMemory nilObject. self commonSend! Item was changed: ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') ----- longPrintOop: oop <api> | fmt lastIndex startIP bytecodesPerLine column | ((objectMemory isImmediate: oop) or: [(objectMemory addressCouldBeObj: oop) not or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0 or: [(objectMemory isFreeObject: oop) or: [objectMemory isForwarded: oop]]]]) ifTrue: [self printOop: oop. ^self]. self printHex: oop. (objectMemory fetchClassOfNonImm: oop) ifNil: [self print: ' has a nil class!!!!'] ifNotNil: [:class| self print: ': a(n) '; printNameOfClass: class count: 5; print: ' ('. objectMemory hasSpurMemoryManagerAPI ifTrue: [self printHexnp: (objectMemory compactClassIndexOf: oop); print: '=>']. self printHexnp: class; print: ')']. fmt := objectMemory formatOf: oop. self print: ' format '; printHexnp: fmt. fmt > objectMemory lastPointerFormat ifTrue: [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)] ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue: [| len | len := objectMemory lengthOf: oop. self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]]. objectMemory printHeaderTypeOf: oop. self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop). self cr. (fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue: [^self printStringOf: oop; cr]. (fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue: [0 to: ((objectMemory num32BitUnitsOf: oop) min: 256) - 1 do: [:i| | fieldOop | fieldOop := objectMemory fetchLong32: i ofObject: oop. self space; printNum: i; space; printHex: fieldOop; space; cr]. ^self]. "this is nonsense. apologies." startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop. lastIndex := 256 min: startIP. lastIndex > 0 ifTrue: [1 to: lastIndex do: [:i| | fieldOop | fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop. self space; printNum: i - 1; space; printHex: fieldOop; space. (i = 1 and: [objectMemory isCompiledMethod: oop]) ifTrue: [self printMethodHeaderOop: fieldOop] ifFalse: [self cCode: [self printOopShort: fieldOop] inSmalltalk: [self print: (self shortPrint: fieldOop)]]. self cr]]. (objectMemory isCompiledMethod: oop) ifFalse: + [startIP > lastIndex ifTrue: [self print: '...'; cr]] - [startIP > 64 ifTrue: [self print: '...'; cr]] ifTrue: [startIP := startIP * objectMemory wordSize + 1. lastIndex := objectMemory lengthOf: oop. lastIndex - startIP > 100 ifTrue: [lastIndex := startIP + 100]. bytecodesPerLine := 8. column := 1. startIP to: lastIndex do: [:index| | byte | column = 1 ifTrue: [self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)' inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']]. byte := objectMemory fetchByte: index - 1 ofObject: oop. self cCode: 'printf(" %02x/%-3d", byte,byte)' inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte]. column := column + 1. column > bytecodesPerLine ifTrue: [column := 1. self cr]]. column = 1 ifFalse: [self cr]]! Item was changed: ----- Method: StackInterpreter>>objCouldBeClassObj: (in category 'debug support') ----- objCouldBeClassObj: objOop "Answer if objOop looks like a class object. WIth Spur be lenient if the object doesn't yet have a hash (i.e. is not yet in the classTable), and accept forwarding pointers." <inline: false> | fieldOop | ^(objectMemory isPointersNonImm: objOop) + and: [(objectMemory numSlotsOfAny: objOop) > InstanceSpecificationIndex - and: [(objectMemory numSlotsOf: objOop) > InstanceSpecificationIndex and: [fieldOop := objectMemory fetchPointer: SuperclassIndex ofObject: objOop. ((objectMemory isNonImmediate: fieldOop) and:[ (objectMemory isPointersNonImm: fieldOop) or: [(objectMemory isOopForwarded: fieldOop) and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]]) and: [fieldOop := objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop. ((objectMemory isNonImmediate: fieldOop) and:[ (objectMemory isPointersNonImm: fieldOop) or: [(objectMemory isOopForwarded: fieldOop) and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]]) and: [(objectMemory isIntegerObject: (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: objOop))]]]]!

1 0

VM Maker: Cog-eem.239.mcz
by commits＠source.squeak.org 03 Feb '15

03 Feb '15

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.239.mcz ==================== Summary ==================== Name: Cog-eem.239 Author: eem Time: 3 February 2015, 1:02:13.213 pm UUID: f2c5a239-5895-4b6c-a7bb-4bfc66c99bf0 Ancestors: Cog-eem.238 Spur bootstrap: Make it an error to fail to find a suitable spur version of the four packages in uploadNewerSpurConfigurationsInTrunk =============== Diff against Cog-eem.238 =============== Item was changed: ----- Method: SpurBootstrapMonticelloPackagePatcher>>spurConfigurationOf:forRepository: (in category 'configurations') ----- spurConfigurationOf: anMCConfiguration forRepository: repo "Answer a copy of anMCConfiguration containing the matching Spur dependencies. If no replacements could be made (because no Spur versions exist) then answer nil." | found clone | found := false. clone := Array streamContents: [:s| s nextPut: #name; nextPut: (anMCConfiguration name copyReplaceAll: 'update-' with: 'update.spur-'); "no location accessor!!!!" nextPut: #repository; nextPut: {anMCConfiguration repositories first locationWithTrailingSlash allButLast}. anMCConfiguration dependencies do: [:dep| | info pkg ver spurVersionName | info := dep versionInfo. ((pkg := self packages detect: [:package| package name = dep package name] ifNone: []) notNil and: [spurVersionName := (info name copyReplaceAll: pkg name with: pkg name, '.spur'), '.mcz'. (ver := MCCacheRepository default versionNamed: spurVersionName asMCVersionName) ifNil: [ver := repo versionNamed: spurVersionName asMCVersionName]. ver notNil]) ifTrue: [found := true. info := ver info]. (ver isNil and: [spurVersionName notNil]) ifTrue: + [Transcript nextPutAll: 'failed to get ', spurVersionName, ' in ', anMCConfiguration name; cr; flush. + self error: 'failed to get ', spurVersionName, ' in ', anMCConfiguration name]. - [Transcript nextPutAll: 'failed to get ', spurVersionName, ' in ', anMCConfiguration name; cr; flush]. s nextPut: #dependency; nextPut: (MCConfiguration dependencyToArray: (MCVersionDependency package: dep package info: info))]]. ^found ifTrue: [MCConfiguration fromArray: clone]!

1 0

Re: [Vm-dev] VM Maker: Cog-eem.238.mcz
by Chris Muller 03 Feb '15

03 Feb '15

Thanks Eliot! I have been running with it and have not run into any issues -- although I guess it only come into play for me when building an image.. On Mon, Feb 2, 2015 at 5:01 PM, <commits(a)source.squeak.org> wrote: > > Eliot Miranda uploaded a new version of Cog to project VM Maker: > http://source.squeak.org/VMMaker/Cog-eem.238.mcz > > ==================== Summary ==================== > > Name: Cog-eem.238 > Author: eem > Time: 2 February 2015, 3:01:40.657 pm > UUID: 632143e7-106b-46e6-8b63-793708755e06 > Ancestors: Cog-eem.237 > > Spur Bootstrap: > Relax the check for a single instance metaclass in > ClassDescription>>EupdateInstances:from:isMeta:. > If the ClassBuilder is using becomeForward: and > avoiding the GC on instance mutation, a metaclass > may be the class of either the mutated class or the > class it is mutated from (oldClass). > > =============== Diff against Cog-eem.237 =============== > > Item was changed: > ----- Method: SpurBootstrapPrototypes>>ClassDescriptionPROTOTYPEupdateInstances:from:isMeta: (in category 'method prototypes') ----- > ClassDescriptionPROTOTYPEupdateInstances: oldInstances from: oldClass isMeta: isMeta > "Recreate any existing instances of the argument, oldClass, as instances of the receiver, > which is a newly changed class. Permute variables as necessary, and forward old instances > to new instances. Answer nil to defeat old clients that expect an array of old instances. > The old behaviour, which necessitated a global GC, exchanged identities and answered > the old instances. But no clients used the result. This way we avoid the unnecessary GC," > | map variable instSize newInstances | > > oldInstances isEmpty ifTrue: > [^nil]. "no instances to convert" > isMeta ifTrue: > [(oldInstances size = 1 > + and: [self soleInstance class == self > + or: [self soleInstance class == oldClass]]) ifFalse: > + [^self error: 'Metaclasses can only have one instance']]. > - and: [self soleInstance class == self]) ifFalse: > - [^self error:'Metaclasses can only have one instance']]. > map := self instVarMappingFrom: oldClass. > variable := self isVariable. > instSize := self instSize. > newInstances := Array new: oldInstances size. > 1 to: oldInstances size do: > [:i| > newInstances > at: i > put: (self newInstanceFrom: (oldInstances at: i) variable: variable size: instSize map: map)]. > "Now perform a bulk mutation of old instances into new ones" > oldInstances elementsForwardIdentityTo: newInstances. > ^nil! >

1 0

VM Maker: Cog-eem.238.mcz
by commits＠source.squeak.org 03 Feb '15

03 Feb '15

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.238.mcz ==================== Summary ==================== Name: Cog-eem.238 Author: eem Time: 2 February 2015, 3:01:40.657 pm UUID: 632143e7-106b-46e6-8b63-793708755e06 Ancestors: Cog-eem.237 Spur Bootstrap: Relax the check for a single instance metaclass in ClassDescription>>EupdateInstances:from:isMeta:. If the ClassBuilder is using becomeForward: and avoiding the GC on instance mutation, a metaclass may be the class of either the mutated class or the class it is mutated from (oldClass). =============== Diff against Cog-eem.237 =============== Item was changed: ----- Method: SpurBootstrapPrototypes>>ClassDescriptionPROTOTYPEupdateInstances:from:isMeta: (in category 'method prototypes') ----- ClassDescriptionPROTOTYPEupdateInstances: oldInstances from: oldClass isMeta: isMeta "Recreate any existing instances of the argument, oldClass, as instances of the receiver, which is a newly changed class. Permute variables as necessary, and forward old instances to new instances. Answer nil to defeat old clients that expect an array of old instances. The old behaviour, which necessitated a global GC, exchanged identities and answered the old instances. But no clients used the result. This way we avoid the unnecessary GC," | map variable instSize newInstances | oldInstances isEmpty ifTrue: [^nil]. "no instances to convert" isMeta ifTrue: [(oldInstances size = 1 + and: [self soleInstance class == self + or: [self soleInstance class == oldClass]]) ifFalse: + [^self error: 'Metaclasses can only have one instance']]. - and: [self soleInstance class == self]) ifFalse: - [^self error:'Metaclasses can only have one instance']]. map := self instVarMappingFrom: oldClass. variable := self isVariable. instSize := self instSize. newInstances := Array new: oldInstances size. 1 to: oldInstances size do: [:i| newInstances at: i put: (self newInstanceFrom: (oldInstances at: i) variable: variable size: instSize map: map)]. "Now perform a bulk mutation of old instances into new ones" oldInstances elementsForwardIdentityTo: newInstances. ^nil!

1 0

[commit][3245] CogVM source as per VMMaker.oscog-eem.1035
by commits＠squeakvm.org 02 Feb '15

02 Feb '15

Revision: 3245 Author: eliot Date: 2015-02-01 18:24:35 -0800 (Sun, 01 Feb 2015) Log Message: ----------- CogVM source as per VMMaker.oscog-eem.1035 Newspeak: Refactor absent receiver shuffling in the interpreter to get more common code. Spur: Comment more carefully the receiver and supersend forwarding invariants, and therefore eliminate internalForwardedReceiver. Update the newspeak AsynchFilePlugin as per VMMaker.oscog-eem.1031. Modified Paths: -------------- branches/Cog/nscogsrc/plugins/AsynchFilePlugin/AsynchFilePlugin.c branches/Cog/nscogsrc/vm/cointerp.c branches/Cog/nscogsrc/vm/cointerp.h branches/Cog/nscogsrc/vm/gcc3x-cointerp.c branches/Cog/nsspursrc/vm/cointerp.c branches/Cog/nsspursrc/vm/cointerp.h branches/Cog/nsspursrc/vm/gcc3x-cointerp.c branches/Cog/nsspurstacksrc/vm/gcc3x-interp.c branches/Cog/nsspurstacksrc/vm/interp.c branches/Cog/sistasrc/vm/cointerp.c branches/Cog/sistasrc/vm/cointerp.h branches/Cog/sistasrc/vm/gcc3x-cointerp.c branches/Cog/spursistasrc/vm/cointerp.c branches/Cog/spursistasrc/vm/cointerp.h branches/Cog/spursistasrc/vm/gcc3x-cointerp.c branches/Cog/spursrc/vm/cointerp.c branches/Cog/spursrc/vm/cointerp.h branches/Cog/spursrc/vm/gcc3x-cointerp.c branches/Cog/spurstack64src/vm/gcc3x-interp.c branches/Cog/spurstack64src/vm/interp.c branches/Cog/spurstacksrc/vm/gcc3x-interp.c branches/Cog/spurstacksrc/vm/interp.c branches/Cog/src/vm/cointerp.c branches/Cog/src/vm/cointerp.h branches/Cog/src/vm/cointerpmt.c branches/Cog/src/vm/cointerpmt.h branches/Cog/src/vm/gcc3x-cointerp.c branches/Cog/src/vm/gcc3x-cointerpmt.c branches/Cog/stacksrc/vm/gcc3x-interp.c branches/Cog/stacksrc/vm/interp.c Property Changed: ---------------- branches/Cog/platforms/Cross/vm/sqSCCSVersion.h Modified: branches/Cog/nscogsrc/plugins/AsynchFilePlugin/AsynchFilePlugin.c =================================================================== --- branches/Cog/nscogsrc/plugins/AsynchFilePlugin/AsynchFilePlugin.c 2015-01-31 02:15:58 UTC (rev 3244) +++ branches/Cog/nscogsrc/plugins/AsynchFilePlugin/AsynchFilePlugin.c 2015-02-02 02:24:35 UTC (rev 3245) @@ -1,9 +1,9 @@ /* Automatically generated by - SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d + SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 from - AsynchFilePlugin VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d + AsynchFilePlugin VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 */ -static char __buildInfo[] = "AsynchFilePlugin VMMaker.oscog-eem.983 uuid: 4cdca841-6318-4c49-95de-8c47d0d7e91d " __DATE__ ; +static char __buildInfo[] = "AsynchFilePlugin VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 " __DATE__ ; @@ -102,9 +102,9 @@ struct VirtualMachine* interpreterProxy; static const char *moduleName = #ifdef SQUEAK_BUILTIN_PLUGIN - "AsynchFilePlugin VMMaker.oscog-eem.983 (i)" + "AsynchFilePlugin VMMaker.oscog-eem.1035 (i)" #else - "AsynchFilePlugin VMMaker.oscog-eem.983 (e)" + "AsynchFilePlugin VMMaker.oscog-eem.1035 (e)" #endif ; static void * sCOAFfn; @@ -182,6 +182,9 @@ primitiveFailFor(PrimErrBadArgument); f = null; l1: /* end asyncFileValueOf: */; + if (failed()) { + return null; + } asyncFileClose(f); if (failed()) { return null; @@ -287,13 +290,11 @@ } success((startIndex >= 1) && (((startIndex + count) - 1) <= bufferSize)); - - /* adjust for zero-origin indexing */ - + if (failed()) { + return null; + } bufferPtr = ((((sqInt) (firstIndexableField(buffer)))) + startIndex) - 1; - if (!(failed())) { - r = asyncFileReadResult(f, bufferPtr, count); - } + r = asyncFileReadResult(f, ((void *)bufferPtr), count); _return_value = integerObjectOf(r); if (failed()) { return null; @@ -325,6 +326,9 @@ primitiveFailFor(PrimErrBadArgument); f = null; l1: /* end asyncFileValueOf: */; + if (failed()) { + return null; + } asyncFileReadStart(f, fPosition, count); if (failed()) { return null; @@ -354,7 +358,10 @@ primitiveFailFor(PrimErrBadArgument); f = null; l1: /* end asyncFileValueOf: */; - r = asyncFileWriteResult(f); + if (failed()) { + return null; + } + r = asyncFileWriteResult(f); _return_value = integerObjectOf(r); if (failed()) { return null; @@ -394,9 +401,6 @@ primitiveFailFor(PrimErrBadArgument); f = null; l1: /* end asyncFileValueOf: */; - if (failed()) { - return null; - } count = num; startIndex = start; @@ -413,13 +417,11 @@ } success((startIndex >= 1) && (((startIndex + count) - 1) <= bufferSize)); - - /* adjust for zero-origin indexing */ - + if (failed()) { + return null; + } bufferPtr = ((((sqInt) (firstIndexableField(buffer)))) + startIndex) - 1; - if (!(failed())) { - asyncFileWriteStart(f, fPosition, bufferPtr, count); - } + asyncFileWriteStart(f, fPosition, ((void *)bufferPtr), count); if (failed()) { return null; } Modified: branches/Cog/nscogsrc/vm/cointerp.c =================================================================== --- branches/Cog/nscogsrc/vm/cointerp.c 2015-01-31 02:15:58 UTC (rev 3244) +++ branches/Cog/nscogsrc/vm/cointerp.c 2015-02-02 02:24:35 UTC (rev 3245) @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.1029 uuid: a2c6da7a-d111-4184-bf10-039ed2bea424 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 from - CoInterpreter VMMaker.oscog-eem.1029 uuid: a2c6da7a-d111-4184-bf10-039ed2bea424 + CoInterpreter VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.1029 uuid: a2c6da7a-d111-4184-bf10-039ed2bea424 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -806,6 +806,7 @@ static sqInt checkHeapIntegrity(void); sqInt checkOkayOop(usqInt oop); static sqInt checkOopIntegritynamed(sqInt obj, char *name) NoDbgRegParms; +static sqInt classForClassTag(sqInt classObj) NoDbgRegParms; sqInt clone(sqInt obj); static double dbgFloatValueOf(sqInt oop) NoDbgRegParms; static sqInt defaultEdenBytes(void); @@ -2097,7 +2098,7 @@ /* 575 */ (void (*)(void))0, 0 }; char expensiveAsserts = 0; -const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreterPrimitives_VMMaker.oscog-eem.1029"; +const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreterPrimitives_VMMaker.oscog-eem.1035"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; volatile int sendTrace; @@ -2171,6 +2172,7 @@ sqInt extA; sqInt extB; sqInt lkupClassTag; + sqInt localAbsentReceiver; char * localFP; char * localIP; sqInt localReturnValue; @@ -4901,6 +4903,7 @@ /* dynamicSuperSendBytecode */ { sqInt aBehavior; + sqInt aValue; sqInt ccIndex; sqInt mClassMixin; sqInt mixin; @@ -4913,6 +4916,8 @@ /* begin literal: */ assert(GIV(method) == (iframeMethod(localFP))); GIV(messageSelector) = longAt((GIV(method) + BaseHeaderSize) + (((byteAtPointer(++localIP)) + LiteralStart) << (shiftForWord()))); + /* begin ensureReceiverUnforwarded */ + ; rcvr = longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop)); mClassMixin = methodClassOf(GIV(method)); /* begin findApplicationOfTargetMixin:startingAtBehavior: */ @@ -4937,9 +4942,7 @@ case 127: /* pushImplicitReceiverBytecode */ { - sqInt followedReceiver; sqInt object; - sqInt rcvr; sqInt selector; VM_LABEL(pushImplicitReceiverBytecode); @@ -4949,12 +4952,8 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - /* begin internalFollowedReceiver */ - rcvr = longAt(localFP + FoxIFReceiver); - - followedReceiver = rcvr; /* begin internalPush: */ - object = implicitReceiverFormixinimplementing(followedReceiver, methodClassOf(GIV(method)), selector); + object = implicitReceiverFormixinimplementing(longAt(localFP + FoxIFReceiver), methodClassOf(GIV(method)), selector); longAtPointerput((localSP -= BytesPerOop), object); } break; @@ -5785,6 +5784,7 @@ superclassSend: /* superclassSend */ { + sqInt aValue; sqInt classPointer; sqInt superclass; @@ -5793,7 +5793,15 @@ classPointer = methodClassOf(GIV(method)); superclass = longAt((classPointer + BaseHeaderSize) + (SuperclassIndex << (shiftForWord()))); (((usqInt) (longAt(superclass))) >> HashBitsOffset) & HashMaskUnshifted; + + /* To maintain the invariant that all receivers are unforwarded we need an explicit + read barrier in the super send cases. Even though we always follow receivers + on become e.g. super doSomethingWith: (self become: other) forwards the receiver + self pushed on the stack. */ + lkupClassTag = superclass; + /* begin ensureReceiverUnforwarded */ + ; assert(lkupClassTag != (nilObject())); goto commonSend; } @@ -12719,7 +12727,7 @@ ? (longAt(rcvr - BaseHeaderSize)) & AllButTypeMask : (/* begin fetchPointer:ofObject: */ longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << (shiftForWord())))) + BaseHeaderSize) + ((ccIndex - 1) << (shiftForWord())))))); - assert(lkupClassTag != (nilObject())); + assert((classForClassTag(lkupClassTag)) != (nilObject())); goto commonSend; } break; @@ -12758,37 +12766,36 @@ commonSendAbsentImplicit: /* commonSendAbsentImplicit */ { - sqInt ccIndex; - sqInt followedReceiver; - sqInt i; - sqInt implicitReceiver; - sqInt oop; - sqInt rcvr; - VM_LABEL(commonSendAbsentImplicit); - /* begin internalFollowedReceiver */ - rcvr = longAt(localFP + FoxIFReceiver); + localAbsentReceiver = implicitReceiverFormixinimplementing(longAt(localFP + FoxIFReceiver), methodClassOf(GIV(method)), GIV(messageSelector)); - followedReceiver = rcvr; - implicitReceiver = implicitReceiverFormixinimplementing(followedReceiver, methodClassOf(GIV(method)), GIV(messageSelector)); - /* begin shuffleArgumentsAndStoreAbsentReceiver: */ + commonSendAbsent: + /* commonSendAbsent */ + { + sqInt ccIndex; + sqInt i; + sqInt oop; - /* a.k.a. self internalPush: anything */ + VM_LABEL(commonSendAbsent); + /* begin shuffleArgumentsAndStoreAbsentReceiver: */ - localSP -= BytesPerOop; - for (i = 1; i <= GIV(argumentCount); i += 1) { - oop = longAtPointer(localSP + (i * BytesPerOop)); - longAtPointerput(localSP + ((i - 1) * BytesPerOop), oop); + /* a.k.a. self internalPush: anything */ + + localSP -= BytesPerOop; + for (i = 1; i <= GIV(argumentCount); i += 1) { + oop = longAtPointer(localSP + (i * BytesPerOop)); + longAtPointerput(localSP + ((i - 1) * BytesPerOop), oop); + } + longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), localAbsentReceiver); + lkupClassTag = ((localAbsentReceiver & 1) + ? longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassSmallInteger << (shiftForWord()))) + : (((ccIndex = (((usqInt) (longAt(localAbsentReceiver))) >> (compactClassFieldLSB())) & 0x1F)) == 0 + ? (longAt(localAbsentReceiver - BaseHeaderSize)) & AllButTypeMask + : (/* begin fetchPointer:ofObject: */ + longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << (shiftForWord())))) + BaseHeaderSize) + ((ccIndex - 1) << (shiftForWord())))))); + assert((classForClassTag(lkupClassTag)) != (nilObject())); + goto commonSend; } - longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), implicitReceiver); - lkupClassTag = ((implicitReceiver & 1) - ? longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassSmallInteger << (shiftForWord()))) - : (((ccIndex = (((usqInt) (longAt(implicitReceiver))) >> (compactClassFieldLSB())) & 0x1F)) == 0 - ? (longAt(implicitReceiver - BaseHeaderSize)) & AllButTypeMask - : (/* begin fetchPointer:ofObject: */ - longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << (shiftForWord())))) + BaseHeaderSize) + ((ccIndex - 1) << (shiftForWord())))))); - assert(lkupClassTag != (nilObject())); - goto commonSend; } break; case 497: /*241*/ @@ -12986,10 +12993,6 @@ /* extSendAbsentSelfBytecode */ { sqInt byte; - sqInt ccIndex; - sqInt classObj; - sqInt i; - sqInt oop; VM_LABEL(extSendAbsentSelfBytecode); byte = byteAtPointer(++localIP); @@ -12999,25 +13002,8 @@ extA = 0; GIV(argumentCount) = (byte & 7) + (extB << 3); extB = 0; - /* begin shuffleArgumentsAndStoreAbsentReceiver: */ - - /* a.k.a. self internalPush: anything */ - - localSP -= BytesPerOop; - for (i = 1; i <= GIV(argumentCount); i += 1) { - oop = longAtPointer(localSP + (i * BytesPerOop)); - longAtPointerput(localSP + ((i - 1) * BytesPerOop), oop); - } - longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), longAt(localFP + FoxIFReceiver)); - /* begin classTagForClass: */ - classObj = (((longAt(localFP + FoxIFReceiver)) & 1) - ? longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassSmallInteger << (shiftForWord()))) - : (((ccIndex = (((usqInt) (longAt(longAt(localFP + FoxIFReceiver)))) >> (compactClassFieldLSB())) & 0x1F)) == 0 - ? (longAt((longAt(localFP + FoxIFReceiver)) - BaseHeaderSize)) & AllButTypeMask - : (/* begin fetchPointer:ofObject: */ - longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << (shiftForWord())))) + BaseHeaderSize) + ((ccIndex - 1) << (shiftForWord())))))); - lkupClassTag = classObj; - goto commonSend; + localAbsentReceiver = longAt(localFP + FoxIFReceiver); + goto commonSendAbsent; } break; case 502: /*246*/ @@ -13140,13 +13126,8 @@ case 510: /*254*/ /* extSendAbsentOuterBytecode */ { - sqInt absentReceiver; sqInt byte; - sqInt ccIndex; - sqInt classObj; sqInt depth; - sqInt i; - sqInt oop; VM_LABEL(extSendAbsentOuterBytecode); byte = byteAtPointer(++localIP); @@ -13157,26 +13138,8 @@ GIV(argumentCount) = (byte & 7) + (extB << 3); extB = 0; depth = byteAtPointer(++localIP); - absentReceiver = enclosingObjectAtwithObjectwithMixin(depth, longAt(localFP + FoxIFReceiver), methodClassOf(GIV(method))); - /* begin shuffleArgumentsAndStoreAbsentReceiver: */ - - /* a.k.a. self internalPush: anything */ - - localSP -= BytesPerOop; - for (i = 1; i <= GIV(argumentCount); i += 1) { - oop = longAtPointer(localSP + (i * BytesPerOop)); - longAtPointerput(localSP + ((i - 1) * BytesPerOop), oop); - } - longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), absentReceiver); - /* begin classTagForClass: */ - classObj = ((absentReceiver & 1) - ? longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassSmallInteger << (shiftForWord()))) - : (((ccIndex = (((usqInt) (longAt(absentReceiver))) >> (compactClassFieldLSB())) & 0x1F)) == 0 - ? (longAt(absentReceiver - BaseHeaderSize)) & AllButTypeMask - : (/* begin fetchPointer:ofObject: */ - longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << (shiftForWord())))) + BaseHeaderSize) + ((ccIndex - 1) << (shiftForWord())))))); - lkupClassTag = classObj; - goto commonSend; + localAbsentReceiver = enclosingObjectAtwithObjectwithMixin(depth, longAt(localFP + FoxIFReceiver), methodClassOf(GIV(method))); + goto commonSendAbsent; } break; } @@ -35401,6 +35364,17 @@ } +/* Compatibility with SpurObjectMemory. In ObjectMemory there is no + distinction between a + classTag in the first-level method cache and a class itself. */ + +static sqInt +classForClassTag(sqInt classObj) +{ + return classObj; +} + + /* Return a shallow copy of the given object. May cause GC. Assume: Oop is a real object, not a small integer. Override to assert it's not a married context and maybe fix cloned Modified: branches/Cog/nscogsrc/vm/cointerp.h =================================================================== --- branches/Cog/nscogsrc/vm/cointerp.h 2015-01-31 02:15:58 UTC (rev 3244) +++ branches/Cog/nscogsrc/vm/cointerp.h 2015-02-02 02:24:35 UTC (rev 3245) @@ -1,5 +1,5 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.1029 uuid: a2c6da7a-d111-4184-bf10-039ed2bea424 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 */ Modified: branches/Cog/nscogsrc/vm/gcc3x-cointerp.c =================================================================== --- branches/Cog/nscogsrc/vm/gcc3x-cointerp.c 2015-01-31 02:15:58 UTC (rev 3244) +++ branches/Cog/nscogsrc/vm/gcc3x-cointerp.c 2015-02-02 02:24:35 UTC (rev 3245) @@ -2,11 +2,11 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.1029 uuid: a2c6da7a-d111-4184-bf10-039ed2bea424 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 from - CoInterpreter VMMaker.oscog-eem.1029 uuid: a2c6da7a-d111-4184-bf10-039ed2bea424 + CoInterpreter VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.1029 uuid: a2c6da7a-d111-4184-bf10-039ed2bea424 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -809,6 +809,7 @@ static sqInt checkHeapIntegrity(void); sqInt checkOkayOop(usqInt oop); static sqInt checkOopIntegritynamed(sqInt obj, char *name) NoDbgRegParms; +static sqInt classForClassTag(sqInt classObj) NoDbgRegParms; sqInt clone(sqInt obj); static double dbgFloatValueOf(sqInt oop) NoDbgRegParms; static sqInt defaultEdenBytes(void); @@ -2100,7 +2101,7 @@ /* 575 */ (void (*)(void))0, 0 }; char expensiveAsserts = 0; -const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreterPrimitives_VMMaker.oscog-eem.1029"; +const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreterPrimitives_VMMaker.oscog-eem.1035"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; volatile int sendTrace; @@ -2174,6 +2175,7 @@ sqInt extA; sqInt extB; sqInt lkupClassTag; + sqInt localAbsentReceiver; register char* localFP FP_REG; register char* localIP IP_REG; sqInt localReturnValue; @@ -4910,6 +4912,7 @@ /* dynamicSuperSendBytecode */ { sqInt aBehavior; + sqInt aValue; sqInt ccIndex; sqInt mClassMixin; sqInt mixin; @@ -4922,6 +4925,8 @@ /* begin literal: */ assert(GIV(method) == (iframeMethod(localFP))); GIV(messageSelector) = longAt((GIV(method) + BaseHeaderSize) + (((byteAtPointer(++localIP)) + LiteralStart) << (shiftForWord()))); + /* begin ensureReceiverUnforwarded */ + ; rcvr = longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop)); mClassMixin = methodClassOf(GIV(method)); /* begin findApplicationOfTargetMixin:startingAtBehavior: */ @@ -4946,9 +4951,7 @@ CASE(127) /* pushImplicitReceiverBytecode */ { - sqInt followedReceiver; sqInt object; - sqInt rcvr; sqInt selector; VM_LABEL(pushImplicitReceiverBytecode); @@ -4958,12 +4961,8 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - /* begin internalFollowedReceiver */ - rcvr = longAt(localFP + FoxIFReceiver); - - followedReceiver = rcvr; /* begin internalPush: */ - object = implicitReceiverFormixinimplementing(followedReceiver, methodClassOf(GIV(method)), selector); + object = implicitReceiverFormixinimplementing(longAt(localFP + FoxIFReceiver), methodClassOf(GIV(method)), selector); longAtPointerput((localSP -= BytesPerOop), object); } BREAK; @@ -5794,6 +5793,7 @@ superclassSend: /* superclassSend */ { + sqInt aValue; sqInt classPointer; sqInt superclass; @@ -5802,7 +5802,15 @@ classPointer = methodClassOf(GIV(method)); superclass = longAt((classPointer + BaseHeaderSize) + (SuperclassIndex << (shiftForWord()))); (((usqInt) (longAt(superclass))) >> HashBitsOffset) & HashMaskUnshifted; + + /* To maintain the invariant that all receivers are unforwarded we need an explicit + read barrier in the super send cases. Even though we always follow receivers + on become e.g. super doSomethingWith: (self become: other) forwards the receiver + self pushed on the stack. */ + lkupClassTag = superclass; + /* begin ensureReceiverUnforwarded */ + ; assert(lkupClassTag != (nilObject())); goto commonSend; } @@ -12728,7 +12736,7 @@ ? (longAt(rcvr - BaseHeaderSize)) & AllButTypeMask : (/* begin fetchPointer:ofObject: */ longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << (shiftForWord())))) + BaseHeaderSize) + ((ccIndex - 1) << (shiftForWord())))))); - assert(lkupClassTag != (nilObject())); + assert((classForClassTag(lkupClassTag)) != (nilObject())); goto commonSend; } BREAK; @@ -12767,37 +12775,36 @@ commonSendAbsentImplicit: /* commonSendAbsentImplicit */ { - sqInt ccIndex; - sqInt followedReceiver; - sqInt i; - sqInt implicitReceiver; - sqInt oop; - sqInt rcvr; - VM_LABEL(commonSendAbsentImplicit); - /* begin internalFollowedReceiver */ - rcvr = longAt(localFP + FoxIFReceiver); + localAbsentReceiver = implicitReceiverFormixinimplementing(longAt(localFP + FoxIFReceiver), methodClassOf(GIV(method)), GIV(messageSelector)); - followedReceiver = rcvr; - implicitReceiver = implicitReceiverFormixinimplementing(followedReceiver, methodClassOf(GIV(method)), GIV(messageSelector)); - /* begin shuffleArgumentsAndStoreAbsentReceiver: */ + commonSendAbsent: + /* commonSendAbsent */ + { + sqInt ccIndex; + sqInt i; + sqInt oop; - /* a.k.a. self internalPush: anything */ + VM_LABEL(commonSendAbsent); + /* begin shuffleArgumentsAndStoreAbsentReceiver: */ - localSP -= BytesPerOop; - for (i = 1; i <= GIV(argumentCount); i += 1) { - oop = longAtPointer(localSP + (i * BytesPerOop)); - longAtPointerput(localSP + ((i - 1) * BytesPerOop), oop); + /* a.k.a. self internalPush: anything */ + + localSP -= BytesPerOop; + for (i = 1; i <= GIV(argumentCount); i += 1) { + oop = longAtPointer(localSP + (i * BytesPerOop)); + longAtPointerput(localSP + ((i - 1) * BytesPerOop), oop); + } + longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), localAbsentReceiver); + lkupClassTag = ((localAbsentReceiver & 1) + ? longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassSmallInteger << (shiftForWord()))) + : (((ccIndex = (((usqInt) (longAt(localAbsentReceiver))) >> (compactClassFieldLSB())) & 0x1F)) == 0 + ? (longAt(localAbsentReceiver - BaseHeaderSize)) & AllButTypeMask + : (/* begin fetchPointer:ofObject: */ + longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << (shiftForWord())))) + BaseHeaderSize) + ((ccIndex - 1) << (shiftForWord())))))); + assert((classForClassTag(lkupClassTag)) != (nilObject())); + goto commonSend; } - longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), implicitReceiver); - lkupClassTag = ((implicitReceiver & 1) - ? longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassSmallInteger << (shiftForWord()))) - : (((ccIndex = (((usqInt) (longAt(implicitReceiver))) >> (compactClassFieldLSB())) & 0x1F)) == 0 - ? (longAt(implicitReceiver - BaseHeaderSize)) & AllButTypeMask - : (/* begin fetchPointer:ofObject: */ - longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << (shiftForWord())))) + BaseHeaderSize) + ((ccIndex - 1) << (shiftForWord())))))); - assert(lkupClassTag != (nilObject())); - goto commonSend; } BREAK; CASE(497) /*241*/ @@ -12995,10 +13002,6 @@ /* extSendAbsentSelfBytecode */ { sqInt byte; - sqInt ccIndex; - sqInt classObj; - sqInt i; - sqInt oop; VM_LABEL(extSendAbsentSelfBytecode); byte = byteAtPointer(++localIP); @@ -13008,25 +13011,8 @@ extA = 0; GIV(argumentCount) = (byte & 7) + (extB << 3); extB = 0; - /* begin shuffleArgumentsAndStoreAbsentReceiver: */ - - /* a.k.a. self internalPush: anything */ - - localSP -= BytesPerOop; - for (i = 1; i <= GIV(argumentCount); i += 1) { - oop = longAtPointer(localSP + (i * BytesPerOop)); - longAtPointerput(localSP + ((i - 1) * BytesPerOop), oop); - } - longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), longAt(localFP + FoxIFReceiver)); - /* begin classTagForClass: */ - classObj = (((longAt(localFP + FoxIFReceiver)) & 1) - ? longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassSmallInteger << (shiftForWord()))) - : (((ccIndex = (((usqInt) (longAt(longAt(localFP + FoxIFReceiver)))) >> (compactClassFieldLSB())) & 0x1F)) == 0 - ? (longAt((longAt(localFP + FoxIFReceiver)) - BaseHeaderSize)) & AllButTypeMask - : (/* begin fetchPointer:ofObject: */ - longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << (shiftForWord())))) + BaseHeaderSize) + ((ccIndex - 1) << (shiftForWord())))))); - lkupClassTag = classObj; - goto commonSend; + localAbsentReceiver = longAt(localFP + FoxIFReceiver); + goto commonSendAbsent; } BREAK; CASE(502) /*246*/ @@ -13149,13 +13135,8 @@ CASE(510) /*254*/ /* extSendAbsentOuterBytecode */ { - sqInt absentReceiver; sqInt byte; - sqInt ccIndex; - sqInt classObj; sqInt depth; - sqInt i; - sqInt oop; VM_LABEL(extSendAbsentOuterBytecode); byte = byteAtPointer(++localIP); @@ -13166,26 +13147,8 @@ GIV(argumentCount) = (byte & 7) + (extB << 3); extB = 0; depth = byteAtPointer(++localIP); - absentReceiver = enclosingObjectAtwithObjectwithMixin(depth, longAt(localFP + FoxIFReceiver), methodClassOf(GIV(method))); - /* begin shuffleArgumentsAndStoreAbsentReceiver: */ - - /* a.k.a. self internalPush: anything */ - - localSP -= BytesPerOop; - for (i = 1; i <= GIV(argumentCount); i += 1) { - oop = longAtPointer(localSP + (i * BytesPerOop)); - longAtPointerput(localSP + ((i - 1) * BytesPerOop), oop); - } - longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), absentReceiver); - /* begin classTagForClass: */ - classObj = ((absentReceiver & 1) - ? longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassSmallInteger << (shiftForWord()))) - : (((ccIndex = (((usqInt) (longAt(absentReceiver))) >> (compactClassFieldLSB())) & 0x1F)) == 0 - ? (longAt(absentReceiver - BaseHeaderSize)) & AllButTypeMask - : (/* begin fetchPointer:ofObject: */ - longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << (shiftForWord())))) + BaseHeaderSize) + ((ccIndex - 1) << (shiftForWord())))))); - lkupClassTag = classObj; - goto commonSend; + localAbsentReceiver = enclosingObjectAtwithObjectwithMixin(depth, longAt(localFP + FoxIFReceiver), methodClassOf(GIV(method))); + goto commonSendAbsent; } BREAK; } @@ -35410,6 +35373,17 @@ } +/* Compatibility with SpurObjectMemory. In ObjectMemory there is no + distinction between a + classTag in the first-level method cache and a class itself. */ + +static sqInt +classForClassTag(sqInt classObj) +{ + return classObj; +} + + /* Return a shallow copy of the given object. May cause GC. Assume: Oop is a real object, not a small integer. Override to assert it's not a married context and maybe fix cloned Modified: branches/Cog/nsspursrc/vm/cointerp.c =================================================================== --- branches/Cog/nsspursrc/vm/cointerp.c 2015-01-31 02:15:58 UTC (rev 3244) +++ branches/Cog/nsspursrc/vm/cointerp.c 2015-02-02 02:24:35 UTC (rev 3245) @@ -1,9 +1,9 @@ /* Automatically generated by - CCodeGeneratorGlobalStructure VMMaker.oscog-eem.1034 uuid: 1a93b31c-cf2c-4a2c-b53f-9eae1d7863c7 + CCodeGeneratorGlobalStructure VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 from - CoInterpreter VMMaker.oscog-eem.1034 uuid: 1a93b31c-cf2c-4a2c-b53f-9eae1d7863c7 + CoInterpreter VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 */ -static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.1034 uuid: 1a93b31c-cf2c-4a2c-b53f-9eae1d7863c7 " __DATE__ ; +static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.1035 uuid: 33a34378-0618-40c7-8fbb-c467fb40fc57 " __DATE__ ; char *__interpBuildInfo = __buildInfo; @@ -2353,7 +2353,7 @@ /*560*/ -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 0, 0, 0,-1,-1 }; char expensiveAsserts = 0; -const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreterPrimitives_VMMaker.oscog-eem.1034"; +const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreterPrimitives_VMMaker.oscog-eem.1035"; sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 40 */; volatile int sendTrace; @@ -2430,6 +2430,7 @@ sqInt extA; sqInt extB; sqInt lkupClassTag; + sqInt localAbsentReceiver; char * localFP; char * localIP; sqInt localReturnValue; @@ -5102,7 +5103,7 @@ if (!((byteAt((localFP + FoxIFrameFlags) + 3)) != 0)) { goto commonCallerReturn; - goto l256; + goto l250; } closure = longAt(localFP + (frameStackedReceiverOffsetNumArgs(((((usqInt)(longAt(localFP + FoxMethod)))) < (startOfMemory()) ? ((mframeCogMethod(localFP))->cmNumArgs) @@ -5155,10 +5156,10 @@ : (byteAt((localFP + FoxIFrameFlags) + 2)) != 0)) { assert(isContext(frameContext(localFP))); ourContext = longAt(localFP + FoxThisContext); - goto l260; + goto l254; } ourContext = marryFrameSP(localFP, localSP); - l260: /* end ensureFrameIsMarried:SP: */; + l254: /* end ensureFrameIsMarried:SP: */; /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), ourContext); /* begin internalPush: */ @@ -5167,7 +5168,7 @@ GIV(argumentCount) = 1; goto normalSend; /* return self */ - goto l256; + goto l250; } if (unwindContextOrNilOrZero != 0) { /* begin internalAboutToReturn:through: */ @@ -5177,10 +5178,10 @@ : (byteAt((localFP + FoxIFrameFlags) + 2)) != 0)) { assert(isContext(frameContext(localFP))); ourContext1 = longAt(localFP + FoxThisContext); - goto l257; + goto l251; } ourContext1 = marryFrameSP(localFP, localSP); - l257: /* end ensureFrameIsMarried:SP: */; + l251: /* end ensureFrameIsMarried:SP: */; /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), ourContext1); /* begin internalPush: */ @@ -5191,7 +5192,7 @@ GIV(argumentCount) = 2; goto normalSend; /* return self */ - goto l256; + goto l250; } contextToReturnTo = null; if (((longAt((home + BaseHeaderSize) + (SenderIndex << (shiftForWord())))) & 1)) { @@ -5248,10 +5249,10 @@ : (byteAt((localFP + FoxIFrameFlags) + 2)) != 0)) { assert(isContext(frameContext(localFP))); ourContext2 = longAt(localFP + FoxThisContext); - goto l259; + goto l253; } ourContext2 = marryFrameSP(localFP, localSP); - l259: /* end ensureFrameIsMarried:SP: */; + l253: /* end ensureFrameIsMarried:SP: */; /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), ourContext2); /* begin internalPush: */ @@ -5260,7 +5261,7 @@ GIV(argumentCount) = 1; goto normalSend; /* return self */ - goto l256; + goto l250; } } assert(pageListIsWellFormed()); @@ -5379,11 +5380,11 @@ GIV(framePointer) = localFP; ceEnterCogCodePopReceiverReg(); - goto l258; + goto l252; } localIP = pointerForOop(longAt(localFP + FoxIFSavedIP)); } - l258: /* end maybeReturnToMachineCodeFrame */; + l252: /* end maybeReturnToMachineCodeFrame */; /* begin setMethod: */ assert((((usqInt)(longAt(localFP + FoxMethod)))) >= (startOfMemory())); GIV(method) = longAt(localFP + FoxMethod); @@ -5397,7 +5398,7 @@ longAtPointerput(localSP, localReturnValue); } - l256: /* end case */; + l250: /* end case */; break; case 121: /* returnTrue */ @@ -5516,27 +5517,27 @@ fp = (thePage->headFP); if (fp == theFP) { frameAbove = 0; - goto l263; + goto l257; } while (((callerFP = frameCallerFP(fp))) != 0) { if (callerFP == theFP) { frameAbove = fp; - goto l263; + goto l257; } fp = callerFP; } error("did not find theFP in stack page"); frameAbove = 0; - l263: /* end findFrameAbove:inPage: */; + l257: /* end findFrameAbove:inPage: */; /* begin newStackPage */ lruOrFree = ((mostRecentlyUsedPage())->nextPage); if (isFree(lruOrFree)) { newPage = lruOrFree; - goto l264; + goto l258; } divorceFramesIn(lruOrFree); newPage = lruOrFree; - l264: /* end newStackPage */; + l258: /* end newStackPage */; assert(newPage == GIV(stackPage)); moveFramesInthroughtoPage(thePage, frameAbove, newPage); markStackPageMostRecentlyUsed(newPage); @@ -5560,7 +5561,7 @@ longAtput((sp2 = GIV(stackPointer) - BytesPerWord), GIV(instructionPointer)); GIV(stackPointer) = sp2; ceSendAborttonumArgs(longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorCannotReturn << (shiftForWord()))), contextToReturnFrom, 1); - goto l262; + goto l256; } GIV(instructionPointer) = 0; thePage = makeBaseFrameFor(contextToReturnTo); @@ -5598,7 +5599,7 @@ GIV(framePointer) = localFP; ceEnterCogCodePopReceiverReg(); - goto l262; + goto l256; } localIP = pointerForOop(longAt(localFP + FoxIFSavedIP)); } @@ -5616,8 +5617,8 @@ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); /* return self */ - l262: /* end baseFrameReturn */; - goto l261; + l256: /* end baseFrameReturn */; + goto l255; } /* begin frameCallerSavedIP: */ localIP = pointerForOop(longAt(localFP + FoxCallerSavedIP)); @@ -5645,7 +5646,7 @@ GIV(framePointer) = localFP; ceEnterCogCodePopReceiverReg(); - goto l261; + goto l255; } localIP = pointerForOop(longAt(localFP + FoxIFSavedIP)); } @@ -5662,12 +5663,13 @@ longAtPointerput(localSP, localReturnValue); } - l261: /* end case */; + l255: /* end case */; break; case 126: /* dynamicSuperSendBytecode */ { sqInt aBehavior; + sqInt aValue; sqInt classIndex; sqInt classObj; sqInt classTablePage; @@ -5678,7 +5680,9 @@ sqInt mixinApplication1; sqInt newHash; sqInt objOop; + sqInt objOop1; sqInt rcvr; + sqInt referent; sqInt tagBits; VM_LABEL(dynamicSuperSendBytecode); @@ -5686,6 +5690,21 @@ /* begin literal: */ assert(GIV(method) == (iframeMethod(localFP))); GIV(messageSelector) = longAt((GIV(method) + BaseHeaderSize) + (((byteAtPointer(++localIP)) + LiteralStart) << (shiftForWord()))); + /* begin ensureReceiverUnforwarded */ + if ((((longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop))) & 3) == 0) + && (((longAt(longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop)))) & 0x3FFFFF) == 8)) { + /* begin internalStackValue:put: */ + /* begin followForwarded: */ + objOop1 = longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop)); + assert(isUnambiguouslyForwarder(objOop1)); + referent = longAt((objOop1 + BaseHeaderSize) + (0 << (shiftForWord()))); + while (((referent & 3) == 0) + && (((longAt(referent)) & 0x3FFFFF) == 8)) { + referent = longAt((referent + BaseHeaderSize) + (0 << (shiftForWord()))); + } + aValue = referent; + longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), aValue); + } rcvr = longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop)); mClassMixin = methodClassOf(GIV(method)); /* begin findApplicationOfTargetMixin:startingAtBehavior: */ @@ -5755,10 +5774,7 @@ case 127: /* pushImplicitReceiverBytecode */ { - sqInt followedReceiver; sqInt object; - sqInt rcvr; - sqInt referent; sqInt selector; VM_LABEL(pushImplicitReceiverBytecode); @@ -5768,23 +5784,8 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - /* begin internalFollowedReceiver */ - rcvr = longAt(localFP + FoxIFReceiver); - if (((rcvr & 3) == 0) - && (((longAt(rcvr)) & 0x3FFFFF) == 8)) { - /* begin followForwarded: */ - assert(isUnambiguouslyForwarder(rcvr)); - referent = longAt((rcvr + BaseHeaderSize) + (0 << (shiftForWord()))); - while (((referent & 3) == 0) - && (((longAt(referent)) & 0x3FFFFF) == 8)) { - referent = longAt((referent + BaseHeaderSize) + (0 << (shiftForWord()))); - } - rcvr = referent; - longAtput(localFP + FoxIFReceiver, rcvr); - } - followedReceiver = rcvr; /* begin internalPush: */ - object = implicitReceiverFormixinimplementing(followedReceiver, methodClassOf(GIV(method)), selector); + object = implicitReceiverFormixinimplementing(longAt(localFP + FoxIFReceiver), methodClassOf(GIV(method)), selector); longAtPointerput((localSP -= BytesPerOop), object); } break; @@ -6052,10 +6053,10 @@ lkupClassTag = ((tagBits & 1) != 0 ? 1 : tagBits); - goto l265; + goto l259; } lkupClassTag = (longAt(rcvr)) & 0x3FFFFF; - l265: /* end fetchClassTagOf: */; + l259: /* end fetchClassTagOf: */; assert(lkupClassTag != (nilObject())); commonSend: @@ -6098,10 +6099,10 @@ classTablePage = longAt((GIV(hiddenRootsObj) + BaseHeaderSize) + ((((usqInt) lkupClassTag) >> 10) << (shiftForWord()))); if (classTablePage == GIV(nilObj)) { classOrInteger = null; - goto l272; + goto l266; } classOrInteger = longAt((classTablePage + BaseHeaderSize) + ((lkupClassTag & ((1 << 10) - 1)) << (shiftForWord()))); - l272: /* end classAtIndex: */; + l266: /* end classAtIndex: */; GIV(traceLog)[GIV(traceLogIndex)] = classOrInteger; GIV(traceLog)[GIV(traceLogIndex) + 1] = GIV(messageSelector); GIV(traceLog)[GIV(traceLogIndex) + 2] = TraceIsFromInterpreter; @@ -6127,7 +6128,7 @@ GIV(newMethod) = GIV(methodCache)[probe + MethodCacheMethod]; primitiveFunctionPointer = ((void (*)()) (GIV(methodCache)[probe + MethodCachePrimFunction])); ok = 1; - goto l267; + goto l261; } /* second probe */ @@ -6138,7 +6139,7 @@ GIV(newMethod) = GIV(methodCache)[probe + MethodCacheMethod]; primitiveFunctionPointer = ((void (*)()) (GIV(methodCache)[probe + MethodCachePrimFunction])); ok = 1; - goto l267; + goto l261; } probe = (((usqInt) hash) >> 2) & MethodCacheMask; if (((GIV(methodCache)[probe + MethodCacheSelector]) == GIV(messageSelector)) @@ -6146,10 +6147,10 @@ GIV(newMethod) = GIV(methodCache)[probe + MethodCacheMethod]; primitiveFunctionPointer = ((void (*)()) (GIV(methodCache)[probe + MethodCachePrimFunction])); ok = 1; - goto l267; + goto l261; } ok = 0; - l267: /* end inlineLookupInMethodCacheSel:classTag: */; + l261: /* end inlineLookupInMethodCacheSel:classTag: */; if (ok) { /* begin ifAppropriateCompileToNativeCode:selector: */ methodHeader2 = longAt((GIV(newMethod) + BaseHeaderSize) + (HeaderIndex << (shiftForWord()))); @@ -6207,7 +6208,7 @@ maybeFlagMethodAsInterpreted(GIV(newMethod)); } } - goto l270; + goto l264; } } /* begin classForClassTag: */ @@ -6218,10 +6219,10 @@ classTablePage1 = longAt((GIV(hiddenRootsObj) + BaseHeaderSize) + ((((usqInt) lkupClassTag) >> 10) << (shiftForWord()))); if (classTablePage1 == GIV(nilObj)) { GIV(lkupClass) = null; - goto l266; + goto l260; } GIV(lkupClass) = longAt((classTablePage1 + BaseHeaderSize) + ((lkupClassTag & ((1 << 10) - 1)) << (shiftForWord()))); - l266: /* end classAtIndex: */; + l260: /* end classAtIndex: */; lookupMethodInClass(GIV(lkupClass)); /* begin internalizeIPandSP */ assert(GIV(instructionPointer) != (ceReturnToInterpreterPC())); @@ -6230,7 +6231,7 @@ localFP = pointerForOop(GIV(framePointer)); addNewMethodToCache(GIV(lkupClass)); } - l270: /* end internalFindNewMethod */; + l264: /* end internalFindNewMethod */; /* begin internalExecuteNewMethod */ if (primitiveFunctionPointer != 0) { if ((((unsigned long) primitiveFunctionPointer)) <= MaxQuickPrimitiveIndex) { @@ -6243,31 +6244,31 @@ /* begin internalStackTopPut: */ longAtPointerput(localSP, longAt(((longAtPointer(localSP)) + BaseHeaderSize) + ((localPrimIndex - 264) << (shiftForWord())))); 1; - goto l268; + goto l262; } if (localPrimIndex == 256) { 1; - goto l268; + goto l262; } if (localPrimIndex == 257) { longAtPointerput(localSP, GIV(trueObj)); 1; - goto l268; + goto l262; } if (localPrimIndex == 258) { longAtPointerput(localSP, GIV(falseObj)); 1; - goto l268; + goto l262; } if (localPrimIndex == 259) { longAtPointerput(localSP, GIV(nilObj)); 1; - goto l268; + goto l262; } longAtPointerput(localSP, (((localPrimIndex - 261) << 1) | 1)); 1; - l268: /* end internalQuickPrimitiveResponse */; - goto l269; + l262: /* end internalQuickPrimitiveResponse */; + goto l263; } /* begin externalizeIPandSP */ assert((((usqInt)localIP)) != (ceReturnToInterpreterPC())); @@ -6331,7 +6332,7 @@ returntoExecutive(popStack(), 1); browserPluginReturnIfNeeded(); null; - goto l269; + goto l263; } } if (methodHasCogMethod(GIV(newMethod))) { @@ -6408,11 +6409,11 @@ table = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (PrimErrTableIndex << (shiftForWord()))); if (GIV(primFailCode) <= ((lastPointerOf(table)) / BytesPerWord)) { errorCode = longAt((table + BaseHeaderSize) + ((GIV(primFailCode) - 1) << (shiftForWord()))); - goto l271; + goto l265; } } errorCode = ((GIV(primFailCode) << 1) | 1); - l271: /* end getErrorObjectFromPrimFailCode */; + l265: /* end getErrorObjectFromPrimFailCode */; longAtPointerput(localSP, errorCode); } GIV(primFailCode) = 0; @@ -6436,7 +6437,7 @@ localFP = pointerForOop(GIV(framePointer)); } } - l269: /* end internalExecuteNewMethod */; + l263: /* end internalExecuteNewMethod */; /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); @@ -6817,12 +6818,15 @@ superclassSend: /* superclassSend */ { + sqInt aValue; sqInt classPointer; sqInt err; sqInt err1; sqInt newHash; sqInt newHash1; sqInt objOop; + sqInt objOop1; + sqInt referent; sqInt superclass; VM_LABEL(superclassSend); @@ -6840,17 +6844,17 @@ if (((newHash = (long32At(superclass + 4)) & 0x3FFFFF)) == 0) { if (!(objCouldBeClassObj(superclass))) { -PrimErrBadReceiver; - goto l273; + goto l267; } if (((err = enterIntoClassTable(superclass))) != 0) { -err; - goto l273; + goto l267; } newHash = (long32At(superclass + 4)) & 0x3FFFFF; assert((classAtIndex(newHash)) == superclass); } newHash; - l273: /* end ensureBehaviorHash: */; + l267: /* end ensureBehaviorHash: */; /* begin classTagForClass: */ assert(addressCouldBeClassObj(superclass)); /* begin ensureBehaviorHash: */ @@ -6858,17 +6862,32 @@ if (((newHash1 = (long32At(superclass + 4)) & 0x3FFFFF)) == 0) { if (!(objCouldBeClassObj(superclass))) { lkupClassTag = -PrimErrBadReceiver; - goto l274; + goto l268; } if (((err1 = enterIntoClassTable(superclass))) != 0) { lkupClassTag = -err1; - goto l274; + goto l268; } newHash1 = (long32At(superclass + 4)) & 0x3FFFFF; assert((classAtIndex(newHash1)) == superclass); } lkupClassTag = newHash1; - l274: /* end ensureBehaviorHash: */; + l268: /* end ensureBehaviorHash: */; + /* begin ensureReceiverUnforwarded */ + if ((((longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop))) & 3) == 0) + && (((longAt(longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop)))) & 0x3FFFFF) == 8)) { + /* begin internalStackValue:put: */ + /* begin followForwarded: */ + objOop1 = longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop)); + assert(isUnambiguouslyForwarder(objOop1)); + referent = longAt((objOop1 + BaseHeaderSize) + (0 << (shiftForWord()))); + while (((referent & 3) == 0) + && (((longAt(referent)) & 0x3FFFFF) == 8)) { + referent = longAt((referent + BaseHeaderSize) + (0 << (shiftForWord()))); + } + aValue = referent; + longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), aValue); + } assert(lkupClassTag != (nilObject())); goto commonSend; } @@ -7870,7 +7889,7 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - goto l275; + goto l269; } if (bytecode == 172) { @@ -7880,7 +7899,7 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - goto l275; + goto l269; } if (bytecode > 167) { @@ -7891,7 +7910,7 @@ localIP = (localIP + offset) + 1; currentBytecode = (byteAtPointer(localIP)) + GIV(bytecodeSetSelector); - goto l275; + goto l269; } } currentBytecode = bytecode + GIV(bytecodeSetSelector); @@ -7899,7 +7918,7 @@ /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), GIV(trueObj)); } - l275: /* end case */; + l269: /* end case */; break; case 179: /* bytecodePrimGreaterThan */ @@ -8016,7 +8035,7 @@ localIP = (localIP + (bytecode - 151)) + 1; currentBytecode = (byteAtPointer(localIP)) + GIV(bytecodeSetSelector); - goto l276; + goto l270; } if (bytecode == 172) { @@ -8027,14 +8046,14 @@ localIP = (localIP + offset) + 1; currentBytecode = (byteAtPointer(localIP)) + GIV(bytecodeSetSelector); - goto l276; + goto l270; } currentBytecode = bytecode + GIV(bytecodeSetSelector); /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), GIV(falseObj)); } - l276: /* end case */; + l270: /* end case */; break; case 180: /* bytecodePrimLessOrEqual */ @@ -10616,7 +10635,7 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - goto l277; + goto l271; } if (bytecode == 244) { @@ -10626,7 +10645,7 @@ /* begin fetchNextBytecode */ currentBytecode = (byteAtPointer(++localIP)) + GIV(bytecodeSetSelector); - goto l277; + goto l271; } if (bytecode == 243) { @@ -10637,7 +10656,7 @@ localIP = (localIP + offset) + 1; currentBytecode = (byteAtPointer(localIP)) + GIV(bytecodeSetSelector); - goto l277; + goto l271; } } currentBytecode = bytecode + GIV(bytecodeSetSelector); @@ -10645,7 +10664,7 @@ /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), GIV(trueObj)); } - l277: /* end case */; + l271: /* end case */; break; case 339: /*83*/ /* bytecodePrimGreaterThanV4 */ @@ -10762,7 +10781,7 @@ localIP = (localIP + (bytecode - 207)) + 1; currentBytecode = (byteAtPointer(localIP)) + GIV(bytecodeSetSelector); - goto l278; + goto l272; } if (bytecode == 244) { @@ -10773,14 +10792,14 @@ localIP = (localIP + offset) + 1; currentBytecode = (byteAtPointer(localIP)) + GIV(bytecodeSetSelector); - goto l278; + goto l272; } currentBytecode = bytecode + GIV(bytecodeSetSelector); /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), GIV(falseObj)); } - l278: /* end case */; + l272: /* end case */; break; case 340: /*84*/ /* bytecodePrimLessOrEqualV4 */ @@ -13077,10 +13096,10 @@ : (byteAt((localFP + FoxIFrameFlags) + 2)) != 0)) { assert(isContext(frameContext(localFP))); ourContext = longAt(localFP + FoxThisContext); - goto l279; + goto l273; } ourContext = marryFrameSP(localFP, localSP); - l279: /* end ensureFrameIsMarried:SP: */; + l273: /* end ensureFrameIsMarried:SP: */; localIP -= 1; /* begin internalPush: */ longAtPointerput((localSP -= BytesPerOop), ourContext); @@ -13848,7 +13867,7 @@ } lkupClassTag = (longAt(rcvr)) & 0x3FFFFF; l240: /* end fetchClassTagOf: */; - assert(lkupClassTag != (nilObject())); + assert((classForClassTag(lkupClassTag)) != (nilObject())); goto commonSend; } break; @@ -13887,52 +13906,39 @@ commonSendAbsentImplicit: /* commonSendAbsentImplicit */ { - sqInt followedReceiver; - sqInt i; - sqInt implicitReceiver; - sqInt oop; - sqInt rcvr; - sqInt referent; - sqInt tagBits; - VM_LABEL(commonSendAbsentImplicit); - /* begin internalFollowedReceiver */ - rcvr = longAt(localFP + FoxIFReceiver); - if (((rcvr & 3) == 0) - && (((longAt(rcvr)) & 0x3FFFFF) == 8)) { - /* begin followForwarded: */ - assert(isUnambiguouslyForwarder(rcvr)); - referent = longAt((rcvr + BaseHeaderSize) + (0 << (shiftForWord()))); - while (((referent & 3) == 0) - && (((longAt(referent)) & 0x3FFFFF) == 8)) { - referent = longAt((referent + BaseHeaderSize) + (0 << (shiftForWord()))); - } - rcvr = referent; - longAtput(localFP + FoxIFReceiver, rcvr); - } - followedReceiver = rcvr; - implicitReceiver = implicitReceiverFormixinimplementing(followedReceiver, methodClassOf(GIV(method)), GIV(messageSelector)); - /* begin shuffleArgumentsAndStoreAbsentReceiver: */ + localAbsentReceiver = implicitReceiverFormixinimplementing(longAt(localFP + FoxIFReceiver), methodClassOf(GIV(method)), GIV(messageSelector)); + + commonSendAbsent: + /* commonSendAbsent */ + { + sqInt i; + sqInt oop; + sqInt tagBits; - /* a.k.a. self internalPush: anything */ + VM_LABEL(commonSendAbsent); + /* begin shuffleArgumentsAndStoreAbsentReceiver: */ - localSP -= BytesPerOop; - for (i = 1; i <= GIV(argumentCount); i += 1) { - oop = longAtPointer(localSP + (i * BytesPerOop)); - longAtPointerput(localSP + ((i - 1) * BytesPerOop), oop); + /* a.k.a. self internalPush: anything */ + + localSP -= BytesPerOop; + for (i = 1; i <= GIV(argumentCount); i += 1) { + oop = longAtPointer(localSP + (i * BytesPerOop)); + longAtPointerput(localSP + ((i - 1) * BytesPerOop), oop); + } + longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), localAbsentReceiver); + /* begin fetchClassTagOf: */ + if (((tagBits = localAbsentReceiver & 3)) != 0) { + lkupClassTag = ((tagBits & 1) != 0 + ? 1 + : tagBits); + goto l274; + } + lkupClassTag = (longAt(localAbsentReceiver)) & 0x3FFFFF; + l274: /* end fetchClassTagOf: */; + assert((classForClassTag(lkupClassTag)) != (nilObject())); + goto commonSend; } - longAtPointerput(localSP + (GIV(argumentCount) * BytesPerOop), implicitReceiver); - /* begin fetchClassTagOf: */ - if (((tagBits = implicitReceiver & 3)) != 0) { - lkupClassTag = ((tagBits & 1) != 0 - ? 1 - : tagBits); - goto l280; - } - lkupClassTag = (longAt(implicitReceiver)) & 0x3FFFFF; @@ Diff output truncated at 50000 characters. @@

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev February 2015