[Vm-dev] VM Maker: VMMaker.oscog-rmacnak.1183.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Apr 11 23:30:42 UTC 2015


Ryan Macnak uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-rmacnak.1183.mcz

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

Name: VMMaker.oscog-rmacnak.1183
Author: rmacnak
Time: 11 April 2015, 4:29:06.815 pm
UUID: 36901a68-c2cb-4b19-8321-67d6aca3e45d
Ancestors: VMMaker.oscog-rmacnak.1182, VMMaker.oscog-eem.1181

Reduce false positives in access control violation reporting by marking the super send we actually use as privileged. Remove unused Newspeak bytecodes.

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

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
  	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver extA extB primitiveFunctionPointer methodCache atCache isPrivateSend 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: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax CheckPrivacyViolations 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 AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax CheckPrivacyViolations 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 VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices 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>>initializeBytecodeTableForNewspeakV3PlusClosures (in category 'initialization') -----
  initializeBytecodeTableForNewspeakV3PlusClosures
  	"StackInterpreter initializeBytecodeTableForNewspeakV3PlusClosures"
  	"Note: This table will be used to generate a C switch statement."
  
  	BytecodeTable := Array new: 256.
  	BytecodeEncoderClassName := #EncoderForNewsqueakV3.
  	LongStoreBytecode := 129.
  	self table: BytecodeTable from:
  	#(
  		(  0  15 pushReceiverVariableBytecode)
  		( 16  31 pushTemporaryVariableBytecode)
  		( 32  63 pushLiteralConstantBytecode)
  		( 64  95 pushLiteralVariableBytecode)
  		( 96 103 storeAndPopReceiverVariableBytecode)
  		(104 111 storeAndPopTemporaryVariableBytecode)
  		(112 pushReceiverBytecode)
  		(113 pushConstantTrueBytecode)
  		(114 pushConstantFalseBytecode)
  		(115 pushConstantNilBytecode)
  		(116 pushConstantMinusOneBytecode)
  		(117 pushConstantZeroBytecode)
  		(118 pushConstantOneBytecode)
  		(119 pushConstantTwoBytecode)
  		(120 returnReceiver)
  		(121 returnTrue)
  		(122 returnFalse)
  		(123 returnNil)
  		(124 returnTopFromMethod)
  		(125 returnTopFromBlock)
  
+ 		(126 unknownBytecode) "Was non-absent dynamic super send"
+ 		(127 unknownBytecode) "Was push implicit receiver"
- 		"2 of the 3 Newspeak bytecodes"
- 		(126 dynamicSuperSendBytecode)
- 		(127 pushImplicitReceiverBytecode)
  
  		(128 extendedPushBytecode)
  		(129 extendedStoreBytecode)
  		(130 extendedStoreAndPopBytecode)
  		(131 singleExtendedSendBytecode)
  		(132 doubleExtendedDoAnythingBytecode)
  		(133 singleExtendedSuperBytecode)
  		(134 secondExtendedSendBytecode)
  		(135 popStackBytecode)
  		(136 duplicateTopBytecode)
  
  		(137 pushActiveContextBytecode)
+ 		(138 pushNewArrayBytecode)
- 		(138 pushNewArrayBytecode)),
  
+ 		(139 callPrimitiveBytecode) "Was push enclosing object"
- 	((initializationOptions at: #SpurObjectMemory ifAbsent: [false])
- 		ifTrue: [#((139 callPrimitiveBytecode))]					"V3PlusClosures on Spur"
- 		ifFalse: [#((139 pushEnclosingObjectBytecode))]),	"Newspeak on V3"
  
- 	  #(
  		(140 pushRemoteTempLongBytecode)
  		(141 storeRemoteTempLongBytecode)
  		(142 storeAndPopRemoteTempLongBytecode)
  		(143 pushClosureCopyCopiedValuesBytecode)
  
  		(144 151 shortUnconditionalJump)
  		(152 159 shortConditionalJumpFalse)
  		(160 167 longUnconditionalJump)
  		(168 171 longJumpIfTrue)
  		(172 175 longJumpIfFalse)
  
  		"176-191 were sendArithmeticSelectorBytecode"
  		(176 bytecodePrimAdd)
  		(177 bytecodePrimSubtract)
  		(178 bytecodePrimLessThan)
  		(179 bytecodePrimGreaterThan)
  		(180 bytecodePrimLessOrEqual)
  		(181 bytecodePrimGreaterOrEqual)
  		(182 bytecodePrimEqual)
  		(183 bytecodePrimNotEqual)
  		(184 bytecodePrimMultiply)
  		(185 bytecodePrimDivide)
  		(186 bytecodePrimMod)
  		(187 bytecodePrimMakePoint)
  		(188 bytecodePrimBitShift)
  		(189 bytecodePrimDiv)
  		(190 bytecodePrimBitAnd)
  		(191 bytecodePrimBitOr)
  
  		"192-207 were sendCommonSelectorBytecode"
  		(192 bytecodePrimAt)
  		(193 bytecodePrimAtPut)
  		(194 bytecodePrimSize)
  		(195 bytecodePrimNext)
  		(196 bytecodePrimNextPut)
  		(197 bytecodePrimAtEnd)
  		(198 bytecodePrimIdentical)
  		(199 bytecodePrimClass)
  		(200 bytecodePrimSpecialSelector24)
  		(201 bytecodePrimValue)
  		(202 bytecodePrimValueWithArg)
  		(203 bytecodePrimDo)
  		(204 bytecodePrimNew)
  		(205 bytecodePrimNewWithArg)
  		(206 bytecodePrimPointX)
  		(207 bytecodePrimPointY)
  
  		(208 223 sendLiteralSelector0ArgsBytecode)
  		(224 239 sendLiteralSelector1ArgBytecode)
  		(240 255 sendLiteralSelector2ArgsBytecode)
  	)!

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."
+ 	MethodHeaderFlagBitPosition := 28 + tagBits.
+ 	AccessModifierPublic := 2r00.
+ 	AccessModifierPrivate := 2r01.
+ 	AccessModifierProtected := 2r10.!
- 	MethodHeaderFlagBitPosition := 28 + tagBits!

Item was removed:
- ----- Method: StackInterpreter>>dynamicSuperSendBytecode (in category 'send bytecodes') -----
- dynamicSuperSendBytecode
- "Send a message to self, starting lookup in the superclass of the method application of the currently executing method's mixin."
- "Assume: messageSelector and argumentCount have been set, and that the receiver and arguments have been pushed onto the stack," 
- "WE WANT THE RECEIVER PUSHED IMPLICITLY, BUT IT IS NOT - SO FAR"
- "Note: This method is inlined into the interpreter dispatch loop."
- 	| rcvr mClassMixin mixinApplication |
- 	<inline: true>
- 	argumentCount := self fetchByte.
- 	messageSelector := self literal: self fetchByte.
- 	"To maintain the invariant that all receivers are unforwarded we need an explicit
- 	 read barrier in the super send cases."
- 	self ensureReceiverUnforwarded.
- 	rcvr := self internalStackValue: argumentCount.
- 	mClassMixin := self methodClassOf: method.
- 	mixinApplication := self 
- 							findApplicationOfTargetMixin: mClassMixin
- 							startingAtBehavior: (objectMemory fetchClassOf: rcvr).
- 	lkupClassTag := objectMemory classTagForClass: (self superclassOf: mixinApplication).
- 	CheckPrivacyViolations ifTrue:
-             [isPrivateSend := true].
- 	self commonSend!

Item was changed:
  ----- Method: StackInterpreter>>extSendAbsentDynamicSuperBytecode (in category 'send bytecodes') -----
  extSendAbsentDynamicSuperBytecode
  	"241		11110001	i i i i i j j j	Send To Dynamic Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
  	| byte mClassMixin mixinApplication |
  	byte := self fetchByte.
  	messageSelector := self literal: (byte >> 3) + (extA << 5).
  	extA := 0.
  	argumentCount := (byte bitAnd: 7) + (extB << 3).
  	extB := 0.
  	self shuffleArgumentsAndStoreAbsentReceiver: self receiver.
  	mClassMixin := self methodClassOf: method.
  	mixinApplication := self 
  							findApplicationOfTargetMixin: mClassMixin
  							startingAtBehavior: (objectMemory fetchClassOf: self receiver).
  	lkupClassTag := objectMemory classTagForClass: (self superclassOf: mixinApplication).
+ 	CheckPrivacyViolations ifTrue:
+             [isPrivateSend := true].
  	self commonSend!

Item was changed:
  ----- Method: StackInterpreter>>extSendAbsentOuterBytecode (in category 'send bytecodes') -----
  extSendAbsentOuterBytecode
  	"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"
  	| byte depth |
  	byte := self fetchByte.
  	messageSelector := self literal: (byte >> 3) + (extA << 5).
  	extA := 0.
  	argumentCount := (byte bitAnd: 7) + (extB << 3).
  	extB := 0.
  	depth := self fetchByte.
  	localAbsentReceiver := self 
  							enclosingObjectAt: depth
  							withObject: self receiver 
  							withMixin: (self methodClassOf: method).
+ 	CheckPrivacyViolations ifTrue:
+             [isPrivateSend := true].
  	self commonSendAbsent!

Item was changed:
  ----- Method: StackInterpreter>>extSendAbsentSelfBytecode (in category 'send bytecodes') -----
  extSendAbsentSelfBytecode
  	"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"
  	| byte |
  	byte := self fetchByte.
  	messageSelector := self literal: (byte >> 3) + (extA << 5).
  	extA := 0.
  	argumentCount := (byte bitAnd: 7) + (extB << 3).
  	extB := 0.
  	localAbsentReceiver := self receiver.
+ 	CheckPrivacyViolations ifTrue:
+             [isPrivateSend := true].
  	self commonSendAbsent!

Item was changed:
  ----- Method: StackInterpreter>>maybeCheckPrivacyOfNewMethod: (in category 'message sending') -----
  maybeCheckPrivacyOfNewMethod: currentClass
  	<inline: true>
  	(NewspeakVM
  	  and: [CheckPrivacyViolations
  	  and: [isPrivateSend not
  	  and: [messageSelector ~= (objectMemory splObj: SelectorDoesNotUnderstand)
+ 	  and: [(self accessModifierOfMethod: newMethod) ~= AccessModifierPublic]]]]) ifTrue:
- 	  and: [(self accessModifierOfMethod: newMethod) ~= 0]]]]) ifTrue:
  		[self print: (self nameOfClass: currentClass); space.
  		 self printStringOf: (messageSelector); print: ' from '.
  		 self printStringOf: (self maybeSelectorOfMethod: method); cr]!

Item was removed:
- ----- Method: StackInterpreter>>pushImplicitReceiverBytecode (in category 'stack bytecodes') -----
- pushImplicitReceiverBytecode
- 	"This bytecode is used to implement outer sends in NS2/NS3. The
- 	 bytecode takes as an argument the literal offset of a selector. It
- 	 effectively finds the nearest lexically-enclosing implementation of
- 	 that selector by searching up the static chain of the receiver,
- 	 starting at the current method."
- 	| selector |
- 	selector := self literal: self fetchByte.
- 	self fetchNextBytecode.
- 	self internalPush: (self
- 						implicitReceiverFor: self receiver
- 						mixin: (self methodClassOf: method)
- 						implementing: selector)!



More information about the Vm-dev mailing list