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

commits at source.squeak.org commits at source.squeak.org
Sun Feb 22 23:04:54 UTC 2015


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

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

Name: VMMaker.oscog-eem.1073
Author: eem
Time: 22 February 2015, 3:03:12.717 pm
UUID: f5e526a5-587e-4182-856d-519220e8efa9
Ancestors: VMMaker.oscog-eem.1072

General:
Add an option to control FailUnbalancedPrimitives and
no longer burden the Stack VMs with the responsibility.

Newspeak VM:
Add an optional CheckPrivacyViolations option and
obey it (thanks, Ryan).

Nuke unused Newspeak configurations.

Slang:
Add code to cast untyped expressions inlined in place
of typed vars, even though currently never triggered.

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

Item was added:
+ ----- Method: CCodeGenerator>>nodeToCast:to: (in category 'inlining') -----
+ nodeToCast: exprNode to: cType
+ 	^TSendNode new
+ 		setSelector: #cCoerceSimple:
+ 		receiver: (TVariableNode new setName: 'self')
+ 		arguments: { exprNode. TConstantNode new setValue: cType }
+ 		isBuiltInOp: true!

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: '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'
- 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver 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'
  	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>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	| vmClass |
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h> /* for e.g. alloca */';
  		addHeaderFile:'<setjmp.h>';
  		addHeaderFile:'<wchar.h> /* for wint_t */';
  		addHeaderFile:'"vmCallback.h"';
  		addHeaderFile:'"sqMemoryFence.h"';
  		addHeaderFile:'"dispdbg.h"'.
  	vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'.
  	aCCodeGenerator
  		var: #interpreterProxy  type: #'struct VirtualMachine*'.
  	aCCodeGenerator
  		declareVar: #sendTrace type: 'volatile int';
  		declareVar: #byteCount type: 'unsigned long'.
  	"These need to be pointers or unsigned."
  	self declareC: #(instructionPointer method newMethod)
  		as: #usqInt
  		in: aCCodeGenerator.
  	"These are all pointers; char * because Slang has no support for C pointer arithmetic."
  	self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit stackMemory breakSelector)
  		as: #'char *'
  		in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #breakSelectorLength
  		declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
  	self declareC: #(stackPage overflowedPage)
  		as: #'StackPage *'
  		in: aCCodeGenerator.
  	aCCodeGenerator removeVariable: 'stackPages'.  "this is an implicit receiver in the translated code."
  	NewspeakVM ifFalse:
  		[aCCodeGenerator removeVariable: 'localAbsentReceiver'].
  	"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
  	 is not defined, for the benefit of the interpreter on slow machines."
  	aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
  	MULTIPLEBYTECODESETS == false ifTrue:
  		[aCCodeGenerator
  			removeVariable: 'extA';
  			removeVariable: 'extB';
  			removeVariable: 'bytecodeSetSelector'].
  	aCCodeGenerator
  		var: #methodCache
  		declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #atCache
  		declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #primitiveTable
  		declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString.
  	vmClass primitiveTable do:
  		[:symbolOrNot|
  		(symbolOrNot isSymbol
  		 and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
  			[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
  				[:tMethod| tMethod returnType: #void]]].
  	vmClass objectMemoryClass hasSpurMemoryManagerAPI
  		ifTrue:
  			[aCCodeGenerator
  				var: #primitiveAccessorDepthTable
  				type: 'signed char'
  				sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
  				array: vmClass primitiveAccessorDepthTable]
  		ifFalse:
  			[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
+ 	(NewspeakVM and: [CheckPrivacyViolations]) ifFalse:
+ 		[aCCodeGenerator removeVariable: #isPrivateSend].
  	aCCodeGenerator
  		var: #primitiveFunctionPointer
  		declareC: 'void (*primitiveFunctionPointer)()'.
  	aCCodeGenerator
  		var: #externalPrimitiveTable
  		declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'.
  	aCCodeGenerator var: #showSurfaceFn type: #'void *'.
  	aCCodeGenerator
  		var: #jmpBuf
  		declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedCallbacks
  		declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedMethods
  		declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #interruptCheckChain
  		declareC: 'void (*interruptCheckChain)(void) = 0'.
  
  	self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
  								longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
  								"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
  								statProcessSwitch statIOProcessEvents statForceInterruptCheck
  								statCheckForEvents statStackOverflow statStackPageDivorce)
  		in: aCCodeGenerator.
  	aCCodeGenerator var: #nextProfileTick type: #sqLong!

Item was changed:
  ----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  
  	super initializeMiscConstants.
  	STACKVM := true.
  
  	"These flags function to identify a GC operation, or
  	 to specify what operations the leak checker should be run for."
  	GCModeFull := 1.				"stop-the-world global GC"
  	GCModeNewSpace := 2.		"Spur's scavenge, or V3's incremental"
  	GCModeIncremental := 4.		"incremental global gc (Dijkstra tri-colour marking); as yet unimplemented"
  	GCModeBecome := 8.			"v3 post-become sweeping"
  	GCModeImageSegment := 16.	"just a flag for leak checking image segments"
  
  	StackPageTraceInvalid := -1.
  	StackPageUnreached := 0.
  	StackPageReachedButUntraced := 1.
  	StackPageTraced := 2.
  
  	DumpStackOnLowSpace := 0.
  	PrimitiveExternalCallIndex := 117. "Primitive index for #primitiveExternalCall"
  	MillisecondClockMask := 16r1FFFFFFF.
  	"Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)"
  	MaxExternalPrimitiveTableSize := 4096. "entries"
  
  	MaxJumpBuf := 32. "max. callback depth"
+ 	FailImbalancedPrimitives := initializationOptions at: #FailImbalancedPrimitives ifAbsentPut: [true].
+ 
+ 	CheckPrivacyViolations := initializationOptions at: #CheckPrivacyViolations ifAbsentPut: [false]!
- 	FailImbalancedPrimitives := true!

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"
  	"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.
+ 	CheckPrivacyViolations ifTrue:
+             [isPrivateSend := true].
  	self commonSend!

Item was changed:
  ----- Method: StackInterpreter>>initialize (in category 'initialization') -----
  initialize
  	"Here we can initialize the variables C initializes to zero.  #initialize methods do /not/ get translated."
  	checkAllocFiller := false. "must preceed initializeObjectMemory:"
  	primFailCode := 0.
  	stackLimit := 0. "This is also the initialization flag for the stack system."
  	stackPage := overflowedPage := 0.
  	extraFramesToMoveOnOverflow := 0.
  	bytecodeSetSelector := 0.
  	highestRunnableProcessPriority := 0.
  	nextProfileTick := 0.
  	nextPollUsecs := 0.
  	nextWakeupUsecs := 0.
  	tempOop := tempOop2 := theUnknownShort := 0.
  	interruptPending := false.
  	inIOProcessEvents := 0.
  	fullScreenFlag := 0.
  	deferDisplayUpdates := false.
  	pendingFinalizationSignals := statPendingFinalizationSignals := 0.
  	globalSessionID := 0.
  	jmpDepth := 0.
  	longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
  	maxExtSemTabSizeSet := false.
+ 	isPrivateSend := false.
  	statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
  	statProcessSwitch := statIOProcessEvents := statStackPageDivorce := 0!

Item was changed:
  ----- Method: StackInterpreter>>internalFindNewMethod (in category 'message sending') -----
  internalFindNewMethod
  	"Find the compiled method to be run when the current messageSelector is sent to the class 'lkupClass', setting the values of 'newMethod' and 'primitiveIndex'."
  	<inline: true>
  	(self inlineLookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
  		["entry was not found in the cache; look it up the hard way"
  		 self externalizeIPandSP.
  		 ((objectMemory isOopForwarded: messageSelector)
  		  or: [objectMemory isForwardedClassTag: lkupClassTag]) ifTrue:
  			[(objectMemory isOopForwarded: messageSelector) ifTrue:
  				[messageSelector := self handleForwardedSelectorFaultFor: messageSelector].
  			 (objectMemory isForwardedClassTag: lkupClassTag) ifTrue:
  				[lkupClassTag := self handleForwardedSendFaultForTag: lkupClassTag].
  			(self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifTrue:
  				[^nil]].
  		 lkupClass := objectMemory classForClassTag: lkupClassTag.
  		 self lookupMethodInClass: lkupClass.
  		 self internalizeIPandSP.
+ 		 self addNewMethodToCache: lkupClass].
+ 	"Clear the flag set in commonSendAbsent and tested in lookupMethodInClass:"
+ 	(NewspeakVM and: [CheckPrivacyViolations]) ifTrue:
+ 		[isPrivateSend := false].!
- 		 self addNewMethodToCache: lkupClass]!

Item was changed:
  ----- Method: StackInterpreter>>lookupMethodInClass: (in category 'message sending') -----
  lookupMethodInClass: class
  	| currentClass dictionary found |
  	<inline: false>
  	self assert: (self addressCouldBeClassObj: class).
  	currentClass := class.
  	[currentClass ~= objectMemory nilObject] whileTrue:
  		[dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
  		dictionary = objectMemory nilObject ifTrue:
  			["MethodDict pointer is nil (hopefully due a swapped out stub)
  				-- raise exception #cannotInterpret:."
  			self createActualMessageTo: class.
  			messageSelector := objectMemory splObj: SelectorCannotInterpret.
  			self sendBreakpoint: messageSelector receiver: nil.
  			^self lookupMethodInClass: (self superclassOf: currentClass)].
  		found := self lookupMethodInDictionary: dictionary.
+ 		(NewspeakVM
+ 		 and: [CheckPrivacyViolations
+ 		 and: [isPrivateSend not
+ 		 and: [messageSelector ~= (objectMemory splObj: SelectorDoesNotUnderstand)
+ 		 and: [(self accessModifierOfMethod: newMethod) ~= 0]]]]) ifTrue:
+ 			[self print: (self nameOfClass: currentClass); space.
+ 			 self printStringOf: (messageSelector); print: ' from '.
+ 			 self printStringOf: (self fetchPointer: 0 ofObject: (self methodClassOf: method)); cr].
  		found ifTrue: [^currentClass].
  		currentClass := self superclassOf: currentClass].
  
  	"Could not find #doesNotUnderstand: -- unrecoverable error."
  	messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue:
  		[self error: 'Recursive not understood error encountered'].
  
  	"Cound not find a normal message -- raise exception #doesNotUnderstand:"
  	self createActualMessageTo: class.
  	messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
  	self sendBreak: messageSelector + objectMemory baseHeaderSize
  		point: (objectMemory lengthOf: messageSelector)
  		receiver: nil.
  	^self lookupMethodInClass: class!

Item was changed:
  ----- Method: TMethod>>argAssignmentsFor:send:in: (in category 'inlining') -----
  argAssignmentsFor: meth send: aSendNode in: aCodeGen
  	"Return a collection of assignment nodes that assign the given argument expressions to the formal parameter variables of the given method."
  	"Optimization: If the actual parameters are either constants or local variables in the target method (the receiver), substitute them directly into the body of meth. Note that global variables cannot be subsituted because the inlined method might depend on the exact ordering of side effects to the globals."
  
  	| stmtList substitutionDict argList |
  	stmtList := OrderedCollection new: 100.
  	substitutionDict := Dictionary new: 100.
  	argList := aSendNode args.
  	
  	meth args size > aSendNode args size ifTrue:
  		[self assert: (meth args first beginsWith: 'self_in_').
  		 argList := {aSendNode receiver}, aSendNode args].
  	meth args with: argList do:
  		[ :argName :exprNode |
  		(self isNode: exprNode substitutableFor: argName inMethod: meth in: aCodeGen)
  			ifTrue:
+ 				[substitutionDict
+ 					at: argName
+ 					put: (((exprNode isSend or: [exprNode isVariable])
+ 						  and: [(self typeFor: argName in: aCodeGen) notNil
+ 						  and: [(aCodeGen typeFor: exprNode in: self) isNil]])
+ 							ifTrue: [aCodeGen nodeToCast: exprNode to: (self typeFor: argName in: aCodeGen)]
+ 							ifFalse: [exprNode]).
- 				[substitutionDict at: argName put: exprNode.
  				 locals remove: argName]
  			ifFalse:
  				[stmtList add: (TAssignmentNode new
  								setVariable: (TVariableNode new setName: argName)
  								expression: exprNode copy)]].
  	meth parseTree: (meth parseTree bindVariablesIn: substitutionDict).
  	^stmtList!

Item was changed:
  ----- Method: VMMaker class>>generateAllCogConfigurationsUnderVersionControl (in category 'configurations') -----
  generateAllCogConfigurationsUnderVersionControl
+ 	self generateNewspeakSpurCogVM;
- 	self generateNewspeakCogVM;
- 		generateNewspeakSpurCogVM;
  		generateSqueakCogVM;
  		generateSqueakCogMTVM;
  		generateSqueakSpurCogVM;
  		generateSqueakCogSistaVM;
  		generateSqueakSpurCogSistaVM!

Item was changed:
  ----- Method: VMMaker class>>generateAllNewspeakConfigurationsUnderVersionControl (in category 'configurations') -----
  generateAllNewspeakConfigurationsUnderVersionControl
+ 	self generateNewspeakSpurStackVM;
- 	self generateNewspeakCogVM;
- 		generateNewspeakSpurStackVM;
  		generateNewspeakSpurCogVM!

Item was changed:
  ----- Method: VMMaker class>>generateAllNonSpurConfigurationsUnderVersionControl (in category 'configurations') -----
  generateAllNonSpurConfigurationsUnderVersionControl
+ 	self generateSqueakCogVM;
- 	self generateNewspeakCogVM;
- 		generateSqueakCogVM;
  		generateSqueakCogMTVM;
  		generateSqueakStackVM;
  		generateSqueakCogSistaVM!

Item was removed:
- ----- Method: VMMaker class>>generateNewspeakCogVM (in category 'configurations') -----
- generateNewspeakCogVM
- 	^VMMaker
- 		generate: CoInterpreter
- 		and: StackToRegisterMappingCogit
- 		with: #(	NewspeakVM true
- 				MULTIPLEBYTECODESETS true)
- 		to: (FileDirectory default pathFromURI: self sourceTree, '/nscogsrc')
- 		platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
- 		including:#(	AsynchFilePlugin BMPReadWriterPlugin BalloonEnginePlugin BitBltSimulation
- 					DeflatePlugin DSAPlugin DropPlugin FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin
- 					ImmX11Plugin JPEGReadWriter2Plugin JPEGReaderPlugin LargeIntegersPlugin
- 					Matrix2x3Plugin MiscPrimitivePlugin NewsqueakIA32ABIPlugin RePlugin
- 					SecurityPlugin SocketPlugin SoundPlugin SqueakSSLPlugin SurfacePlugin
- 					UUIDPlugin UnixOSProcessPlugin UnixAioPlugin
- 					VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin Win32OSProcessPlugin)!

Item was removed:
- ----- Method: VMMaker class>>generateNewspeakInterpreterVM (in category 'configurations') -----
- generateNewspeakInterpreterVM
- 	^VMMaker
- 		generate: NewspeakInterpreter
- 		to: (FileDirectory default pathFromURI: self sourceTree, '/nssrc')
- 		platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
- 		including:#(	AsynchFilePlugin BMPReadWriterPlugin BalloonEnginePlugin BitBltSimulation DeflatePlugin DSAPlugin DropPlugin
- 					FileCopyPlugin FilePlugin FloatArrayPlugin FloatMathPlugin ImmX11Plugin JPEGReadWriter2Plugin
- 					JPEGReaderPlugin LargeIntegersPlugin Matrix2x3Plugin MiscPrimitivePlugin NewsqueakIA32ABIPlugin
- 					RePlugin SecurityPlugin SocketPlugin SoundPlugin SqueakSSLPlugin SurfacePlugin
- 					UUIDPlugin UnixOSProcessPlugin VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin Win32OSProcessPlugin)!

Item was changed:
  ----- Method: VMMaker class>>generateNewspeakSpurStackVM (in category 'configurations') -----
  generateNewspeakSpurStackVM
+ 	"No primitives since we can use those from the Cog Newspeak VM"
- 	"No primitives since we can use those for the Cog Newspeak VM"
  	^VMMaker
  		generate: StackInterpreter
  		with: #(	ObjectMemory Spur32BitMemoryManager
  				MULTIPLEBYTECODESETS true
+ 				NewspeakVM true
+ 				FailImbalancedPrimitives false
+ 				CheckPrivacyViolations true)
- 				NewspeakVM true)
  		to: (FileDirectory default directoryNamed: self sourceTree, '/nsspurstacksrc') fullName
  		platformDir: (FileDirectory default directoryNamed: self sourceTree, '/platforms') fullName
  		including: #()!

Item was removed:
- ----- Method: VMMaker class>>generateNewspeakStackVM (in category 'configurations') -----
- generateNewspeakStackVM
- 	"No primitives since we can use those for the Cog Newspeak VM"
- 	^VMMaker
- 		generate: StackInterpreter
- 		with: #(NewspeakVM true MULTIPLEBYTECODESETS true)
- 		to: (FileDirectory default pathFromURI: self sourceTree, '/nsstacksrc')
- 		platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
- 		including: #()!

Item was changed:
  ----- Method: VMMaker class>>generateSqueakSpurStack64VM (in category 'configurations') -----
  generateSqueakSpurStack64VM
+ 	"No primitives since we can use those from the Cog VM"
- 	"No primitives since we can use those for the Cog VM"
  	^VMMaker
  		generate: StackInterpreter
+ 		with: #(ObjectMemory Spur64BitMemoryManager
+ 				FailImbalancedPrimitives false)
- 		with: #(ObjectMemory Spur64BitMemoryManager)
  		to: (FileDirectory default directoryNamed: self sourceTree, '/spurstack64src') fullName
  		platformDir: (FileDirectory default directoryNamed: self sourceTree, '/platforms') fullName
  		including: #()!

Item was changed:
  ----- Method: VMMaker class>>generateSqueakSpurStackVM (in category 'configurations') -----
  generateSqueakSpurStackVM
+ 	"No primitives since we can use those from the Cog VM"
- 	"No primitives since we can use those for the Cog VM"
  	^VMMaker
  		generate: StackInterpreter
+ 		with: #(ObjectMemory Spur32BitMemoryManager
+ 				FailImbalancedPrimitives false)
- 		with: #(ObjectMemory Spur32BitMemoryManager)
  		to: (FileDirectory default directoryNamed: self sourceTree, '/spurstacksrc') fullName
  		platformDir: (FileDirectory default directoryNamed: self sourceTree, '/platforms') fullName
  		including: #()!

Item was changed:
  ----- Method: VMMaker class>>generateSqueakStackVM (in category 'configurations') -----
  generateSqueakStackVM
+ 	"No primitives since we can use those from the Cog VM"
- 	"No primitives since we can use those for the Cog VM"
  	^VMMaker
  		generate: StackInterpreter
+ 		with: #(FailImbalancedPrimitives false)
  		to: (FileDirectory default directoryNamed: self sourceTree, '/stacksrc') fullName
  		platformDir: (FileDirectory default directoryNamed: self sourceTree, '/platforms') fullName
  		including: #()!



More information about the Vm-dev mailing list