[Vm-dev] VM Maker: VMMaker.oscog-eem.1026.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jan 23 00:42:56 UTC 2015


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

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

Name: VMMaker.oscog-eem.1026
Author: eem
Time: 22 January 2015, 4:41:41.71 pm
UUID: 58161d66-0b23-4356-89f1-8e951fd1a1d9
Ancestors: VMMaker.oscog-eem.1025

Fix type regression in primitiveBitShift due to 64-bits.

Reduce the max num literals in the alternate header
format to 15, and steal the bit for the Sista
optimized method flag.

Provide accessModifier methods for Newspeak.

=============== Diff against VMMaker.oscog-eem.1025 ===============

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveBitShift (in category 'arithmetic integer primitives') -----
  primitiveBitShift 
  	| integerReceiver integerArgument shifted |
+ 	<var: #integerReceiver type: #sqInt>
  	integerArgument := self stackTop.
  	(objectMemory isIntegerObject: integerArgument) ifFalse:
  		[^self primitiveFail].
  	integerReceiver := self stackValue: 1.
  	objectMemory wordSize = 4
  		ifTrue:
  			[integerReceiver := self positive32BitValueOf: integerReceiver]
  		ifFalse:
  			[integerReceiver := self signed64BitValueOf: integerReceiver].
  	self successful ifTrue:
  		[(integerArgument := objectMemory integerValueOf: integerArgument) >= 0
  			ifTrue: "Left shift -- must fail bits would be lost"
  				[integerArgument <= objectMemory numSmallIntegerBits ifFalse:
  					[^self primitiveFail].
  				shifted := integerReceiver << integerArgument.
  				integerReceiver = (objectMemory wordSize = 4
  									ifTrue: [shifted >> integerArgument]
  									ifFalse: [shifted >>> integerArgument])  ifFalse:
  					[^self primitiveFail]]
  			ifFalse: "Right shift -- OK to lose bits"
  				[integerArgument >= objectMemory numSmallIntegerBits negated ifFalse:
  					[^self primitiveFail].
  				 shifted := integerReceiver >> (0 - integerArgument)].
  		shifted := objectMemory wordSize = 4
  					ifTrue: [self positive32BitIntegerFor: shifted]
  					ifFalse:
  						[(objectMemory isIntegerValue: shifted)
  							ifTrue: [objectMemory integerObjectOf: shifted]
  							ifFalse: [self signed64BitIntegerFor: shifted]].
  		self pop: 2 thenPush: shifted]!

Item was changed:
  ----- Method: SpurMemoryManager>>literalCountOfMethodHeader: (in category 'method access') -----
  literalCountOfMethodHeader: header
  	<api>
  	<inline: true>
  	self assert: (self isIntegerObject: header).
+ 	^coInterpreter literalCountOfAlternateHeader: header!
- 	^(self integerValueOf: header) bitAnd: 16rFFFF!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
  	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals'
+ 	classVariableNames: 'AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask'
- 	classVariableNames: 'AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask'
  	poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMSqueakV3BytecodeConstants VMStackFrameOffsets'
  	category: 'VMMaker-Interpreter'!
  
  !StackInterpreter commentStamp: 'eem 12/5/2014 11:32' prior: 0!
  This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.  This VM supports Closures but *not* old-style BlockContexts.
  
  It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
  
  The VM does not use Contexts directly.  Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image.  There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up.  The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations.  A send establishes a new frame in the current stack page, a return returns to the previous frame.  This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return.  Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together).  Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died).  A married context is specially marked (more details in the code) and refers to its frame.  Likewise a married frame is specially marked and refers to its context.
  
  In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
  
  StackInterpreter and subclasses support multiple memory managers.  Currently there are two.  NewMemoryManager is a slightly refined version of ObjectMemory, and is the memory manager and garbage collector for the original Squeak object representation as described in "Back to the Future The Story of Squeak, A Practical Smalltalk Written in Itself", see http://ftp.squeak.org/docs/OOPSLA.Squeak.html.  Spur is a faster, more regular object representation that is designed for more performance and functionality, and to have a common header format for both 32-bit and 64-bit versions.  You can read about it in SpurMemoryManager's class comment.  There is also a video of a presentation at ESUG 2014 (https://www.youtube.com/watch?v=k0nBNS1aHZ4), along with slides (http://www.slideshare.net/esug/spur-a-new-object-representation-for-cog?related=1).!

Item was changed:
  ----- Method: StackInterpreter class>>initializeMethodIndices (in category 'initialization') -----
  initializeMethodIndices
  	| tagBits |
  	"Class CompiledMethod"
  	HeaderIndex := 0.
  	LiteralStart := 1.
  
  	tagBits := self objectMemoryClass numSmallIntegerTagBits.
  	LargeContextBit := 16r20000 << tagBits.  "This bit set in method headers if large context is needed."
  	MethodHeaderTempCountShift := 18 + tagBits.
  	MethodHeaderArgCountShift := 24 + tagBits.
  	V3PrimitiveBitsMask := 16r100001FF << tagBits.
  	AlternateHeaderHasPrimFlag := 16r10000 << tagBits.
+ 	AlternateHeaderIsOptimizedFlag := 16r8000 << tagBits.
+ 	AlternateHeaderNumLiteralsMask := 16r7FFF. "N.B.  *not* shifted"
  	"The position of the unused flag bit in the method header, not including tag bit(s).
+ 	 Bits 28 & 29 are either used as an accessModifer code in Newspeak (public, private, protected)
+ 	 or are free for use as flag bits."
- 	 This is used either as the `has been interpreted' flag or the `is an optimized method' flag; the
- 	 latter if this is a Sista VM."
  	MethodHeaderFlagBitPosition := 28 + tagBits!

Item was added:
+ ----- Method: StackInterpreter>>accessModifierOfMethod: (in category 'compiled methods') -----
+ accessModifierOfMethod: methodObj
+ 	<option: #NewspeakVM>
+ 	^self accessModifierOfMethodHeader: (objectMemory methodHeaderOf: methodObj)!

Item was added:
+ ----- Method: StackInterpreter>>accessModifierOfMethodHeader: (in category 'compiled methods') -----
+ accessModifierOfMethodHeader: header
+ 	<option: #NewspeakVM>
+ 	"accessModifier bits:
+ 		 00 public
+ 		 01 private
+ 		 10 protected
+ 		 11 undefined"
+ 	^header >> MethodHeaderFlagBitPosition bitAnd: 3!

Item was changed:
  ----- Method: StackInterpreter>>isOptimizedMethod: (in category 'compiled methods') -----
+ isOptimizedMethod: methodObj
- isOptimizedMethod: header
  	<api>
  	<option: #SistaVM>
+ 	^self isOptimizedMethodHeader: (objectMemory methodHeaderOf: methodObj)!
- 	^header >> MethodHeaderFlagBitPosition anyMask: 1!

Item was added:
+ ----- Method: StackInterpreter>>isOptimizedMethodHeader: (in category 'compiled methods') -----
+ isOptimizedMethodHeader: header
+ 	<option: #SistaVM>
+ 	^header anyMask: AlternateHeaderIsOptimizedFlag!

Item was added:
+ ----- Method: StackInterpreter>>isPrivateMethod: (in category 'compiled methods') -----
+ isPrivateMethod: methodObj
+ 	<option: #NewspeakVM>
+ 	^(self accessModifierOfMethod: methodObj) = 1!

Item was added:
+ ----- Method: StackInterpreter>>isProtectedMethod: (in category 'compiled methods') -----
+ isProtectedMethod: methodObj
+ 	<option: #NewspeakVM>
+ 	^(self accessModifierOfMethod: methodObj) = 2!

Item was added:
+ ----- Method: StackInterpreter>>isPublicMethod: (in category 'compiled methods') -----
+ isPublicMethod: methodObj
+ 	<option: #NewspeakVM>
+ 	^(self accessModifierOfMethod: methodObj) = 0!

Item was changed:
  ----- Method: StackInterpreter>>literalCountOfAlternateHeader: (in category 'compiled methods') -----
  literalCountOfAlternateHeader: headerPointer
  	<inline: true>
+ 	^(objectMemory integerValueOf: headerPointer) bitAnd: AlternateHeaderNumLiteralsMask!
- 	^(objectMemory integerValueOf: headerPointer) bitAnd: 16rFFFF!



More information about the Vm-dev mailing list