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

commits at source.squeak.org commits at source.squeak.org
Tue May 20 01:04:36 UTC 2014


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

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

Name: VMMaker.oscog-eem.721
Author: eem
Time: 19 May 2014, 6:01:54.576 pm
UUID: 0b57bb7c-ae00-4c31-8399-05cea9c1ce79
Ancestors: VMMaker.oscog-eem.720

Slang:
In non-production VMs add an attribute to disable register
parameters (at least for GCC-compliant compilers), allowing
all static functions to be called from gdb even in the -O1
assert VMs.

Newspeak:
Delete unused misnomer for push outer bytecode.

Spur:
Split the check heap loop between newSpace and oldSpace
to improve leak map checking performance a little.

VMMaker
Add the useful expressions to the do... menu if present.

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

Item was changed:
  Object subclass: #CCodeGenerator
  	instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors logger suppressAsmLabels asmLabelCounts pools selectorTranslations optionsDictionary breakSrcInlineSelector breakDestInlineSelector vmMaker'
+ 	classVariableNames: 'NoRegParmsInAssertVMs UseRightShiftForDivide'
- 	classVariableNames: 'UseRightShiftForDivide'
  	poolDictionaries: 'VMBasicConstants'
  	category: 'VMMaker-Translation to C'!
  
  !CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
  This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.  
  See VMMaker for more useful info!

Item was changed:
  ----- Method: CCodeGenerator class>>initialize (in category 'class initialization') -----
  initialize
  	"CCodeGenerator initialize"
  
  	UseRightShiftForDivide := true.
  		"If UseRightShiftForDivide is true, the translator will generate a right-shift when it encounters a division by a constant that is a small power of two. For example, 'x / 8' will generate '((int) x >> 3)'. The coercion to int is done to make it clear that the C compiler should generate a signed shift."
  		"Note: The Kernighan and Ritchie 2nd Edition C manual, p. 49, leaves the semantics of right-shifting a negative number open to the discretion of the compiler implementor. However, it strongly suggests that most compilers should generate an arithmetic right shift (i.e., shifting in the sign bit), which is the same as dividing by a power of two. If your compiler does not generate or simulate an arithmetic shift, then make this class variable false and re-translate."
+ 
+ 	NoRegParmsInAssertVMs := true
+ 		"If NoRegParmsInAssertVMs is true the generator spits out an attribute turning off register parameters for static functions in the Assert and Debug VMs which makes debugging easier, since all functions can be safely called from gdb.  One might hope that -mregparm=0 would work but at least on Mac OS X's gcc 4.2.1 it does not and hence we have to use a per funciton attribute.  Sigh..."!
- !

Item was changed:
  ----- Method: CCodeGenerator>>emitCFunctionPrototypes:on: (in category 'C code generator') -----
  emitCFunctionPrototypes: methodList on: aStream 
  	"Store prototype declarations for all non-inlined methods on the given stream."
  	| exporting |
  	aStream cr; nextPutAll: '/*** Function Prototypes ***/'; cr.
+ 	"Hmm, this should be in the sqConfig.h files.  For now put it here..."
+ 	NoRegParmsInAssertVMs ifTrue:
+ 		[aStream cr; cr; nextPutAll: '#if defined(PRODUCTION) && !!PRODUCTION && defined(__GNUC__) && !!defined(NoDbgRegParms)\# define NoDbgRegParms __attribute__ ((regparm (0)))\#endif' withCRs.
+ 		 aStream cr; cr; nextPutAll: '#if !!defined(NoDbgRegParms)\# define NoDbgRegParms /*empty*/\#endif' withCRs.
+ 		 aStream cr; cr].
  	exporting := false.
  	(methodList select: [:m| m isRealMethod]) do:
  		[:m |
  		self emitExportPragma ifTrue:
  			[m export
  				ifTrue: [exporting ifFalse: 
  							[aStream nextPutAll: '#pragma export on'; cr.
  							exporting := true]]
  				ifFalse: [exporting ifTrue: 
  							[aStream nextPutAll: '#pragma export off'; cr.
  							exporting := false]]].
  		m emitCFunctionPrototype: aStream generator: self.
+ 		(NoRegParmsInAssertVMs and: [m export not and: [m isStatic and: [m args notEmpty]]]) ifTrue:
+ 			[aStream nextPutAll: ' NoDbgRegParms'].
  		aStream nextPut: $; ; cr].
  	exporting ifTrue: [aStream nextPutAll: '#pragma export off'; cr].
  	aStream cr!

Item was removed:
- ----- Method: NewspeakInterpreter>>pushExplicitOuterSendReceiverBytecode (in category 'stack bytecodes') -----
- pushExplicitOuterSendReceiverBytecode
- "Find the appropriate implicit receiver for outer N"
- 	|  mClassMixin  litIndex  n anInt |
- 	<inline: true>
- 	litIndex := self fetchByte.
- 	anInt := self literal: litIndex.
- 	n := self checkedIntegerValueOf: anInt.
- 	self fetchNextBytecode.
- 	mClassMixin := self methodClassOf: method.
- 	self internalPush:(self 
- 		explicitOuterReceiver: n 
- 		withObject: receiver 
- 		withMixin: mClassMixin
- 		)
- !

Item was changed:
  ----- Method: SpurMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
  checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ 	"Perform an integrity/leak check using the heapMap.  Assume clearLeakMapAndMapAccessibleObjects
+ 	 has set a bit at each object's header.  Scan all objects in the heap checking that every pointer points
+ 	 to a header.  Scan the rememberedSet, remapBuffer and extraRootTable checking that every entry is
+ 	 a pointer to a header. Check that the number of roots is correct and that all rememberedSet entries
+ 	 have their isRemembered: flag set.  Answer if all checks pass."
+ 	| ok numRememberedObjectsInHeap |
- 	"Perform an integrity/leak check using the heapMap.  Assume
- 	 clearLeakMapAndMapAccessibleObjects has set a bit at each
- 	 object's header.  Scan all objects in the heap checking that every
- 	 pointer points to a header.  Scan the rootTable, remapBuffer and
- 	 extraRootTable checking that every entry is a pointer to a header.
- 	 Check that the number of roots is correct and that all rootTable
- 	 entries have their rootBit set. Answer if all checks pass."
- 	| ok numRememberedRootsInHeap |
  	<inline: false>
  	ok := true.
+ 	numRememberedObjectsInHeap := 0.
+ 	"Excuse the duplication but performance is at a premium and we avoid
+ 	 some tests by splitting the newSpace and oldSpace enumerations."
+ 	self allNewSpaceEntitiesDo:
+ 		[:obj| | fieldOop classIndex classOop |
- 	numRememberedRootsInHeap := 0.
- 	self allHeapEntitiesDo:
- 		[:obj| | containsYoung fieldOop classIndex classOop |
  		((self isFreeObject: obj)
+ 		 or: [(self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]]) ifFalse:
+ 			[(self isRemembered: obj) ifTrue:
+ 				[coInterpreter print: 'young object '; printHex: obj; print: ' is remembered'; cr.
+ 				 self eek.
+ 				 ok := false]].
+ 			 (self isForwarded: obj)
+ 				ifTrue:
+ 					[fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
+ 					 (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ 						[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
+ 						 self eek.
+ 						 ok := false]]
+ 				ifFalse:
+ 					[classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
+ 					 (classIndicesShouldBeValid
+ 					  and: [classOop = nilObj
+ 					  and: [(self isHiddenObj: obj) not]]) ifTrue:
+ 						[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
+ 						 self eek.
+ 						 ok := false].
+ 					 0 to: (self numPointerSlotsOf: obj) - 1 do:
+ 						[:fi|
+ 						 fieldOop := self fetchPointer: fi ofObject: obj.
+ 						 (self isNonImmediate: fieldOop) ifTrue:
+ 							[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ 								[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
+ 								 self eek.
+ 								 ok := false]]]]].
+ 	self allOldSpaceEntitiesDo:
+ 		[:obj| | containsYoung fieldOop classIndex classOop |
+ 		(self isFreeObject: obj) ifFalse:
- 		 or: [(self isYoungObject: obj) and: [(self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]]]) ifFalse:
  			[containsYoung := false.
  			 (self isRemembered: obj) ifTrue:
+ 				[numRememberedObjectsInHeap := numRememberedObjectsInHeap + 1.
- 				[numRememberedRootsInHeap := numRememberedRootsInHeap + 1.
  				 (scavenger isInRememberedSet: obj) ifFalse:
  					[coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
  					 self eek.
  					 ok := false]].
  			 (self isForwarded: obj)
  				ifTrue:
  					[fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
  					 (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
  						[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
  						 self eek.
  						 ok := false].
+ 					 (self isReallyYoung: fieldOop) ifTrue:
- 					 (self isYoung: fieldOop) ifTrue:
  						[containsYoung := true]]
  				ifFalse:
  					[classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
  					 (classIndicesShouldBeValid
  					  and: [classOop = nilObj
  					  and: [(self isHiddenObj: obj) not]]) ifTrue:
  						[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
  						 self eek.
  						 ok := false].
+ 					 0 to: (self numPointerSlotsOf: obj) - 1 do:
+ 						[:fi|
+ 						 fieldOop := self fetchPointer: fi ofObject: obj.
- 					 self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do:
- 						[:ptr|
- 						 fieldOop := self longAt: obj + ptr.
  						 (self isNonImmediate: fieldOop) ifTrue:
+ 							[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ 								[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
+ 								 self eek.
+ 								 ok := false].
+ 							 "don't be misled by CogMethods; they appear to be young, but they're not"
+ 							 (self isReallyYoung: fieldOop) ifTrue:
+ 								[containsYoung := true]]]].
+ 					containsYoung ifTrue:
- 							[| fi |
- 							 fi := ptr - self baseHeaderSize / self wordSize.
- 							 (fieldOop bitAnd: self wordSize - 1) ~= 0
- 								ifTrue:
- 									[coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
- 									 self eek.
- 									 ok := false]
- 								ifFalse:
- 									[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
- 										[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
- 										 self eek.
- 										 ok := false].
- 									 "don't be misled by CogMethods; they appear to be young, but they're not"
- 									 ((self isYoung: fieldOop)
- 									  and: [self oop: fieldOop isGreaterThanOrEqualTo: newSpaceStart]) ifTrue:
- 										[containsYoung := true]]]]].
- 					(containsYoung and: [(self isYoung: obj) not]) ifTrue:
  						[(self isRemembered: obj) ifFalse:
  							[coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
  							 self eek.
  							 ok := false]]]].
+ 	numRememberedObjectsInHeap ~= scavenger rememberedSetSize ifTrue:
- 	numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
  		[coInterpreter
  			print: 'root count mismatch. #heap roots ';
+ 			printNum: numRememberedObjectsInHeap;
- 			printNum: numRememberedRootsInHeap;
  			print: '; #roots ';
  			printNum: scavenger rememberedSetSize;
  			cr.
  		self eek.
  		"But the system copes with overflow..."
  		self flag: 'no support for remembered set overflow yet'.
  		"ok := rootTableOverflowed and: [needGCFlag]"].
  	scavenger rememberedSetWithIndexDo:
  		[:obj :i|
  		(obj bitAnd: self wordSize - 1) ~= 0
  			ifTrue:
  				[coInterpreter print: 'misaligned oop in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
  						 self eek.
  						 ok := false]
  					ifFalse:
  						[(self isYoung: obj) ifTrue:
  							[coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
  							 self eek.
  							 ok := false]]]].
  	1 to: remapBufferCount do:
  		[:ri| | obj |
  		obj := remapBuffer at: ri.
  		(obj bitAnd: self wordSize - 1) ~= 0
  			ifTrue:
  				[coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
  					[coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  					 self eek.
  					 ok := false]]].
  	1 to: extraRootCount do:
  		[:ri| | obj |
  		obj := (extraRoots at: ri) at: 0.
  		(obj bitAnd: self wordSize - 1) ~= 0
  			ifTrue:
  				[coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
  					[coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  					 self eek.
  					 ok := false]]].
  	^ok!

Item was changed:
  ----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveState (in category 'primitive support') -----
  checkForAndFollowForwardedPrimitiveState
  	"In Spur a primitive may fail due to encountering a forwarder.
  	 On failure check the accessorDepth for the primitive and
  	 if non-negative scan the args to the depth, following any
  	 forwarders.  Answer if any are found so the prim can be retried."
  	<option: #SpurObjectMemory>
  	| primIndex accessorDepth found |
  	self assert: self successful not.
  	found := false.
- 	self assert: argumentCount = (self argumentCountOf: newMethod).
  	primIndex := self primitiveIndexOf: newMethod.
  	accessorDepth := primitiveAccessorDepthTable at: primIndex.
  	"For the method-executing primitives, failure could have been in those primitives or the
  	 primitives of the methods they execute.  find out which failed by seeing what is in effect."
  	primIndex caseOf: {
  		[117] -> 
  			[primitiveFunctionPointer ~~ #primitiveExternalCall ifTrue:
+ 				[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
+ 			 self assert: argumentCount = (self argumentCountOf: newMethod)].
+ 		[118] -> "with tryPrimitive:withArgs: the argument count has nothing to do with newMethod's, so no arg count assert."
- 				[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod]].
- 		[118] ->
  			[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject)].
  		[218] ->
  			[primitiveFunctionPointer ~~ #primitiveDoNamedPrimitiveWithArgs ifTrue:
+ 				[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
+ 			 self assert: argumentCount = (self argumentCountOf: newMethod)]. }
- 				[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod]]. }
  		otherwise:
+ 			[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject).
+ 			 self assert: argumentCount = (self argumentCountOf: newMethod)].
- 			[self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject)].
  	accessorDepth >= 0 ifTrue:
  		[0 to: argumentCount do:
  			[:index| | oop |
  			oop := self stackValue: index.
  			(objectMemory isNonImmediate: oop) ifTrue:
  				[(objectMemory isForwarded: oop) ifTrue:
  					[self assert: index < argumentCount. "receiver should have been caught at send time."
  					 found := true.
  					 oop := objectMemory followForwarded: oop.
  					 self stackValue: index put: oop].
  				((objectMemory hasPointerFields: oop)
  				 and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]) ifTrue:
  					[found := true]]]].
  	^found!

Item was removed:
- ----- Method: StackInterpreter>>pushExplicitOuterSendReceiverBytecode (in category 'stack bytecodes') -----
- pushExplicitOuterSendReceiverBytecode
- 	"Find the appropriate implicit receiver for outer N"
- 	| litIndex  n anIntOop |
- 	<inline: true>
- 	litIndex := self fetchByte.
- 	anIntOop := self literal: litIndex.
- 	n := (objectMemory isIntegerObject: anIntOop)
- 			ifTrue: [objectMemory integerValueOf: anIntOop]
- 			ifFalse: [0].
- 	self fetchNextBytecode.
- 	self internalPush:(self 
- 						explicitOuterReceiver: n 
- 						withObject: self receiver 
- 						withMixin: (self methodClassOf: method))!

Item was added:
+ ----- Method: VMClass class>>initialize (in category 'initialization') -----
+ initialize
+ 	(Utilities classPool at: #CommonRequestStrings ifAbsent: []) ifNotNil:
+ 		[:commonRequestStringHolder|
+ 		(commonRequestStringHolder contents asString includesSubString: 'VMClass open') ifFalse:
+ 			[Utilities appendToCommonRequests: '-\VMMaker generateConfiguration\VMMaker generateAllConfigurationsUnderVersionControl\VMMaker generateAllSpurConfigurations\VMClass openCogMultiWindowBrowser\VMClass openObjectMemoriesInterpretersBrowser\VMClass openSpurMultiWindowBrowser' withCRs]]!



More information about the Vm-dev mailing list