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

commits at source.squeak.org commits at source.squeak.org
Mon Mar 18 20:23:11 UTC 2013 

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

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

Name: VMMaker.oscog-eem.273
Author: eem
Time: 18 March 2013, 1:20:54.297 pm
UUID: 0a8e74b7-9351-45ea-b8a3-56969530c62e
Ancestors: VMMaker.oscog-eem.272

Integrate VMMaker-dtl.302:
A WordArray parameter in the parameter list of a primitive declaration should be declared as (unsigned *) not (usqInt *) in the generated C code. Fix WordArray class>>ccgDeclareCForVar: code generation and provide a unit test.

Also remove redundant type declaration in HostWindowPlugin>>primitiveShowHostWindow:bits:width:height:depth:left:right:top:bottom: which was an ineffective attempt to work around the code generation bug.

Cogit in-image tests:
Fix the facade now that absent-receiver inline caches are
disassembled prettily.
Allow supplying VM config options to pc-mapping tests.
Put VMClass defaultIntegerBaseInDebugger in a class var for quick
flipping between decimal and hex.

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

Item was changed:
  ----- Method: Cogit class>>testPCMappingFor: (in category 'tests') -----
  testPCMappingFor: aCompiledMethod
+ 	^self testPCMappingFor: aCompiledMethod options: #()!
- 	| tuple |
- 	tuple := self cog: aCompiledMethod selector: aCompiledMethod selector.
- 	tuple second testPCMappingForMethod: tuple last!

Item was added:
+ ----- Method: Cogit class>>testPCMappingFor:options: (in category 'tests') -----
+ testPCMappingFor: aCompiledMethod options: optionsDictionaryOrArray
+ 	| tuple |
+ 	tuple := self cog: aCompiledMethod selector: aCompiledMethod selector options: optionsDictionaryOrArray.
+ 	tuple second testPCMappingForMethod: tuple last!

Item was changed:
  ----- Method: Cogit class>>testPCMappingSelect: (in category 'tests') -----
  testPCMappingSelect: aBlock
  	"Test pc mapping both ways using the methods in the current image"
+ 	self testPCMappingSelect: aBlock options: #()!
- 	| cogit coInterpreter |
- 	self initialize.
- 	cogit := self new.
- 	coInterpreter := CurrentImageCoInterpreterFacade new cogit: cogit; yourself.
- 	[cogit
- 			setInterpreter: coInterpreter;
- 			singleStep: true;
- 			initializeCodeZoneFrom: 1024 upTo: coInterpreter memory size]
- 		on: Notification
- 		do: [:ex|
- 			(ex messageText beginsWith: 'cannot find receiver for') ifTrue:
- 				[ex resume: coInterpreter]].
- 	SystemNavigation new allSelect:
- 		[:m| | cm |
- 		(m isQuick not
- 		 and: [aBlock value: m]) ifTrue:
- 			[Transcript nextPut: $.; flush.
- 			 [cm := cogit
- 						cog: (coInterpreter oopForObject: m)
- 						selector: (coInterpreter oopForObject: m selector).
- 			   cm isNil and: [coInterpreter isCogCompiledCodeCompactionCalledFor]] whileTrue:
- 				[cogit methodZone clearCogCompiledCode.
- 				 coInterpreter clearCogCompiledCodeCompactionCalledFor.
- 				 coInterpreter initializeObjectMap].
- 			 cogit testPCMappingForMethod: cm].
- 		 false]!

Item was added:
+ ----- Method: Cogit class>>testPCMappingSelect:options: (in category 'tests') -----
+ testPCMappingSelect: aBlock options: optionsDictionaryOrArray
+ 	"Test pc mapping both ways using the methods in the current image"
+ 	| cogit coInterpreter |
+ 	self initializeWithOptions: (self asOptionsDictionary: optionsDictionaryOrArray).
+ 	cogit := self new.
+ 	coInterpreter := CurrentImageCoInterpreterFacade new cogit: cogit; yourself.
+ 	[cogit
+ 			setInterpreter: coInterpreter;
+ 			singleStep: true;
+ 			initializeCodeZoneFrom: 1024 upTo: coInterpreter memory size]
+ 		on: Notification
+ 		do: [:ex|
+ 			(ex messageText beginsWith: 'cannot find receiver for') ifTrue:
+ 				[ex resume: coInterpreter]].
+ 	SystemNavigation new allSelect:
+ 		[:m| | cm |
+ 		(m isQuick not
+ 		 and: [aBlock value: m]) ifTrue:
+ 			[Transcript nextPut: $.; flush.
+ 			 [cm := cogit
+ 						cog: (coInterpreter oopForObject: m)
+ 						selector: (coInterpreter oopForObject: m selector).
+ 			   cm isNil and: [coInterpreter isCogCompiledCodeCompactionCalledFor]] whileTrue:
+ 				[cogit methodZone clearCogCompiledCode.
+ 				 coInterpreter clearCogCompiledCodeCompactionCalledFor.
+ 				 coInterpreter initializeObjectMap].
+ 			 cogit testPCMappingForMethod: cm].
+ 		 false]!

Item was changed:
  ----- Method: Cogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') -----
  mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg
  	"Machine-code <-> bytecode pc mapping support.  Evaluate functionSymbol
  	 for each mcpc, bcpc pair in the map until the function returns non-zero,
  	 answering that result, or 0 if it fails to.  This works only for frameful methods."
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(char *mcpc, sqInt bcpc, void *arg)'>
  	<var: #arg type: #'void *'>
  	| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
  	  latestContinuation byte descriptor bsOffset nExts |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #homeMethod type: #'CogMethod *'>
  	self assert: cogMethod stackCheckOffset > 0.
  	"In both CMMethod and CMBlock cases find the start of the map and
  	 skip forward to the bytecode pc map entry for the stack check."
  	cogMethod cmType = CMMethod
  		ifTrue:
  			[isInBlock := false.
  			 homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
  			 self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
  			 map := self mapStartFor: homeMethod.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]).
  			 latestContinuation := startbcpc.
  			 aMethodObj := homeMethod methodObject.
  			 endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1.
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader]
  		ifFalse:
  			[isInBlock := true.
  			 homeMethod := cogMethod cmHomeMethod.
  			 map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
  						inMethod: homeMethod.
  			 self assert: map ~= 0.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial"
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]).
  			 [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  				[map := map - 1].
  			 map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header."
  			 aMethodObj := homeMethod methodObject.
  			 bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader).
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
  			 byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  			 descriptor := self generatorAt: byte.
  			 endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj].
  	bcpc := startbcpc.
  	mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
  	nExts := 0.
  	"The stack check maps to the start of the first bytecode,
  	 the first bytecode being effectively after frame build."
  	result := self perform: functionSymbol
  					with: (self cCoerceSimple: mcpc to: #'char *')
  					with: startbcpc
  					with: arg.
  	result ~= 0 ifTrue:
  		[^result].
  	"Now skip up through the bytecode pc map entry for the stack check." 
  	[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  		[map := map - 1].
  	map := map - 1.
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc"
  		[mapByte >= FirstAnnotation
  			ifTrue:
  				[| annotation nextBcpc |
  				annotation := mapByte >> AnnotationShift.
  				mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
  				(self isPCMappedAnnotation: annotation) ifTrue:
  					[[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  					  descriptor := self generatorAt: byte.
  					  isInBlock
  						ifTrue: [bcpc >= endbcpc ifTrue: [^0]]
  						ifFalse:
+ 							[(descriptor isReturn and: [bcpc >= latestContinuation]) ifTrue: [^0].
- 							[(descriptor isReturn and: [bcpc > latestContinuation]) ifTrue: [^0].
  							 (descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
  								[| targetPC |
  								 targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  								 latestContinuation := latestContinuation max: targetPC]].
  					  nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  					  descriptor isMapped
  					  or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
  						[bcpc := nextBcpc.
  						 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  					"All subsequent bytecodes except backward branches map to the
  					 following bytecode. Backward branches map to themselves other-
  					 wise mapping could cause premature breaking out of loops." 
  					result := self perform: functionSymbol
  									with: (self cCoerceSimple: mcpc to: #'char *')
  									with: ((descriptor isBranch
  										   and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj])
  											ifTrue: [bcpc]
  											ifFalse: [bcpc + descriptor numBytes])
  									with: arg.
  					 result ~= 0 ifTrue:
  						[^result].
  					 bcpc := nextBcpc.
  					 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]]
  			ifFalse:
  				[mcpc := mcpc + (mapByte >= DisplacementX2N
  									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  									ifFalse: [mapByte])].
  		 map := map - 1].
  	^0!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>addressCouldBeObj: (in category 'debug support') -----
+ addressCouldBeObj: address
+ 	^(address bitAnd: 3) = 0
+ 	  and: [self addressCouldBeOop: address]!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>objectForOop: (in category 'private-cacheing') -----
  objectForOop: anOop
  	"This is a keyAtValue: search and so needs speeding up either by a reverse map or a simple cache."
  	^(anOop bitAnd: 3) caseOf: {
  		[0] -> [anOop = cachedOop
  				ifTrue: [cachedObject]
+ 				ifFalse: [cachedObject := objectMap keyAtValue: anOop. "may raise Error"
+ 						cachedOop := anOop. "Dom't assign until accessed without error"
+ 						cachedObject]].
- 				ifFalse: [cachedObject := objectMap keyAtValue: (cachedOop := anOop)]].
  		[1] -> [anOop signedIntFromLong >> 1].
  		[3] -> [anOop signedIntFromLong >> 1] }!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>unalignedLongAt: (in category 'accessing') -----
+ unalignedLongAt: index 
+ 	^memory unsignedLongAt: index + 1!

Item was changed:
  ----- Method: HostWindowPlugin>>primitiveShowHostWindow:bits:width:height:depth:left:right:top:bottom: (in category 'system primitives') -----
  primitiveShowHostWindow: windowIndex bits: dispBits width: w height: h depth: d
  left: left right: right top: top bottom: bottom
  "Host window analogue of DisplayScreen> primShowRectLeft:right:top:bottom:
  (Interpreter>primitiveShowDisplayRect) which takes the window index, bitmap
  details and the rectangle bounds. Fail if the windowIndex is invalid or the
  platform routine returns false to indicate failure"
  	|ok|
- 	<var: #dispBits type: #'unsigned char *'>
  	self primitive: 'primitiveShowHostWindowRect'
  		parameters: #(SmallInteger WordArray SmallInteger SmallInteger SmallInteger
  SmallInteger SmallInteger SmallInteger SmallInteger).
  
  	"Tell the vm to copy pixel's from dispBits to the screen - this is just
  ioShowDisplay with the extra parameter of the windowIndex integer"
  	ok := self cCode: 'ioShowDisplayOnWindow(dispBits, w, h, d, left, right, top,
  bottom, windowIndex)'.
  	ok ifFalse:[interpreterProxy primitiveFail]!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') -----
  mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg
  	"Machine-code <-> bytecode pc mapping support.  Evaluate functionSymbol
  	 for each mcpc, bcpc pair in the map until the function returns non-zero,
  	 answering that result, or 0 if it fails to.  This works only for frameful methods.
  
  	 Override to add the descriptor as the first argument to function."
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor * desc, char *mcpc, sqInt bcpc, void *arg)'>
  	<var: #arg type: #'void *'>
  	| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
  	  latestContinuation byte descriptor bsOffset nExts |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #homeMethod type: #'CogMethod *'>
  	self assert: cogMethod stackCheckOffset > 0.
  	"In both CMMethod and CMBlock cases find the start of the map and
  	 skip forward to the bytecode pc map entry for the stack check."
  	cogMethod cmType = CMMethod
  		ifTrue:
  			[isInBlock := false.
  			 homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
  			 self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
  			 map := self mapStartFor: homeMethod.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = IsAbsPCReference
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsRelativeCall
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]]).
  			 latestContinuation := startbcpc.
  			 aMethodObj := homeMethod methodObject.
  			 endbcpc := (objectMemory byteLengthOf: aMethodObj) - 1.
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader]
  		ifFalse:
  			[isInBlock := true.
  			 homeMethod := cogMethod cmHomeMethod.
  			 map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
  						inMethod: homeMethod.
  			 self assert: map ~= 0.
  			 self assert: ((objectMemory byteAt: map) >> AnnotationShift = HasBytecodePC "fiducial"
  						 or: [(objectMemory byteAt: map) >> AnnotationShift = IsDisplacementX2N]).
  			 [(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  				[map := map - 1].
  			 map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header."
  			 aMethodObj := homeMethod methodObject.
  			 bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader).
  			 bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
  			 byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  			 descriptor := self generatorAt: byte.
  			 endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj].
  	bcpc := startbcpc.
  	mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
  	nExts := 0.
  	"as a hack for collecting counters, remember the prev mcpc in a static variable."
  	prevMapAbsPCMcpc := 0.
  	"The stack check maps to the start of the first bytecode,
  	 the first bytecode being effectively after frame build."
  	result := self perform: functionSymbol
  					with: nil
  					with: (self cCoerceSimple: mcpc to: #'char *')
  					with: startbcpc
  					with: arg.
  	result ~= 0 ifTrue:
  		[^result].
  	"Now skip up through the bytecode pc map entry for the stack check." 
  	[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
  		[map := map - 1].
  	map := map - 1.
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc"
  		[mapByte >= FirstAnnotation
  			ifTrue:
  				[| annotation nextBcpc |
  				annotation := mapByte >> AnnotationShift.
  				mcpc := mcpc + (mapByte bitAnd: DisplacementMask).
  				(self isPCMappedAnnotation: annotation) ifTrue:
  					[[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
  					  descriptor := self generatorAt: byte.
  					  isInBlock
  						ifTrue: [bcpc >= endbcpc ifTrue: [^0]]
  						ifFalse:
+ 							[(descriptor isReturn and: [bcpc >= latestContinuation]) ifTrue: [^0].
- 							[(descriptor isReturn and: [bcpc > latestContinuation]) ifTrue: [^0].
  							 (descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
  								[| targetPC |
  								 targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  								 latestContinuation := latestContinuation max: targetPC]].
  					  nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
  					  descriptor isMapped
  					  or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
  						[bcpc := nextBcpc.
  						 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  					"All subsequent bytecodes except backward branches map to the
  					 following bytecode. Backward branches map to themselves other-
  					 wise mapping could cause premature breaking out of loops." 
  					result := self perform: functionSymbol
  									with: descriptor
  									with: (self cCoerceSimple: mcpc to: #'char *')
  									with: ((self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj)
  											ifTrue: [bcpc]
  											ifFalse: [bcpc + descriptor numBytes])
  									with: arg.
  					 result ~= 0 ifTrue:
  						[^result].
  					 bcpc := nextBcpc].
  				annotation = IsAbsPCReference ifTrue:
  					[prevMapAbsPCMcpc := mcpc]]
  			ifFalse:
  				[mcpc := mcpc + (mapByte >= DisplacementX2N
  									ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  									ifFalse: [mapByte])].
  		 map := map - 1].
  	^0!

Item was changed:
  Object subclass: #VMClass
  	instanceVariableNames: ''
+ 	classVariableNames: 'DefaultBase'
- 	classVariableNames: ''
  	poolDictionaries: 'VMBasicConstants'
  	category: 'VMMaker-Support'!
  VMClass class
  	instanceVariableNames: 'timeStamp'!
  
  !VMClass commentStamp: '<historical>' prior: 0!
  I am an abstract superclass for all classes in the VM that want to maintain a source timeStamp.!
  VMClass class
  	instanceVariableNames: 'timeStamp'!

Item was changed:
  ----- Method: VMClass class>>defaultIntegerBaseInDebugger (in category 'debugger') -----
  defaultIntegerBaseInDebugger
+ 	"DefaultBase := 16."
+ 	"DefaultBase := 10."
+ 	DefaultBase isNil ifTrue: [DefaultBase := 16].
+ 	^DefaultBase!
- 	^16!

Item was changed:
  ----- Method: WordArray class>>ccgDeclareCForVar: (in category '*VMMaker-plugin generation') -----
  ccgDeclareCForVar: aSymbolOrString
+ 	"Address of an unsigned 32 bit value, regardless of Smalltalk wordSize"
  
+ 	^'unsigned *', aSymbolOrString!
- 	^'usqInt *', aSymbolOrString!

More information about the Vm-dev mailing list