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

commits at source.squeak.org commits at source.squeak.org
Fri Dec 5 23:03:07 UTC 2014


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

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

Name: VMMaker.oscog-eem.967
Author: eem
Time: 5 December 2014, 3:00:37.278 pm
UUID: 546b1d7c-4cc7-4e0c-b2a3-4e2877fb821e
Ancestors: VMMaker.oscog-eem.966

Extend the -breakmnu facilities to break on
creating MNU PIC entries, not just activating them.

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

Item was removed:
- ----- Method: CoInterpreter>>compilationBreak:point: (in category 'debug support') -----
- compilationBreak: selectorOop point: selectorLength
- 	<api>
- 	<cmacro: '(sel, len) do { \
- 	if ((len) == breakSelectorLength \
- 	 && !!strncmp((char *)((sel) + BaseHeaderSize), breakSelector, breakSelectorLength)) { \
- 		suppressHeartbeatFlag = 1; \
- 		compilationBreakpointFor(sel); \
- 	} \
- } while (0)'>
- 	| i |
- 	breakSelectorLength = selectorLength ifTrue:
- 		[i := breakSelectorLength.
- 		 [i > 0] whileTrue:
- 			[(objectMemory byteAt: selectorOop + i + objectMemory baseHeaderSize - 1) = (breakSelector at: i) asInteger
- 				ifTrue: [(i := i - 1) = 0 ifTrue:
- 							[self compilationBreakpointFor: selectorOop]]
- 				ifFalse: [i := 0]]]!

Item was added:
+ ----- Method: CoInterpreter>>compilationBreak:point:isMNUCase: (in category 'debug support') -----
+ compilationBreak: selectorOop point: selectorLength isMNUCase: isMNUCase
+ 	<api>
+ 	<cmacro: '(sel, len, isMNU) do { \
+ 	if ((len) == (isMNU ? -breakSelectorLength : breakSelectorLength) \
+ 	 && !!strncmp((char *)((sel) + BaseHeaderSize), breakSelector, (isMNU ? -breakSelectorLength : breakSelectorLength))) { \
+ 		suppressHeartbeatFlag = 1; \
+ 		compilationBreakpointFor(sel); \
+ 	} \
+ } while (0)'>
+ 	| bsl i |
+ 	bsl := isMNUCase ifTrue: [breakSelectorLength negated] ifFalse: [breakSelectorLength].
+ 	bsl = selectorLength ifTrue:
+ 		[i := bsl.
+ 		 [i > 0] whileTrue:
+ 			[(objectMemory byteAt: selectorOop + i + objectMemory baseHeaderSize - 1) = (breakSelector at: i) asInteger
+ 				ifTrue: [(i := i - 1) = 0 ifTrue:
+ 							[self compilationBreakpointFor: selectorOop]]
+ 				ifFalse: [i := 0]]]!

Item was added:
+ ----- Method: CoInterpreter>>mnuCompilationBreak:point: (in category 'debug support') -----
+ mnuCompilationBreak: selectorOop point: selectorLength
+ 	<api>
+ 	<cmacro: '(sel, len) do { \
+ 	if ((len) == -breakSelectorLength \
+ 	 && !!strncmp((char *)((sel) + BaseHeaderSize), breakSelector, -breakSelectorLength)) { \
+ 		suppressHeartbeatFlag = 1; \
+ 		compilationBreakpointFor(sel); \
+ 	} \
+ } while (0)'>
+ 	| i |
+ 	breakSelectorLength negated = selectorLength ifTrue:
+ 		[i := breakSelectorLength negated.
+ 		 [i > 0] whileTrue:
+ 			[(objectMemory byteAt: selectorOop + i + objectMemory baseHeaderSize - 1) = (breakSelector at: i) asInteger
+ 				ifTrue: [(i := i - 1) = 0 ifTrue:
+ 							[self mnuCompilationBreakpointFor: selectorOop]]
+ 				ifFalse: [i := 0]]]!

Item was added:
+ ----- Method: CoInterpreter>>mnuCompilationBreakpointFor: (in category 'debug support') -----
+ mnuCompilationBreakpointFor: selectorOop
+ 	<api>
+ 	suppressHeartbeatFlag := true.
+ 	self
+ 		cCode: [self warning: 'compilation MNU break (heartbeat suppressed)']
+ 		inSmalltalk: [self halt: 'Compilation for MNU of ', breakSelector]!

Item was changed:
  ----- Method: Cogit>>cog:selector: (in category 'jit - api') -----
  cog: aMethodObj selector: aSelectorOop
  	"Attempt to produce a machine code method for the bytecode method
  	 object aMethodObj.  N.B. If there is no code memory available do *NOT*
  	 attempt to reclaim the method zone.  Certain clients (e.g. ceSICMiss:)
  	 depend on the zone remaining constant across method generation."
  	<api>
  	<returnTypeC: #'CogMethod *'>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	self assert: ((coInterpreter methodHasCogMethod: aMethodObj) not
  				or: [(self noAssertMethodClassAssociationOf: aMethodObj) = objectMemory nilObject]).
  	"coInterpreter stringOf: aSelectorOop"
  	coInterpreter
  		compilationBreak: aSelectorOop
+ 		point: (objectMemory lengthOf: aSelectorOop)
+ 		isMNUCase: false.
- 		point: (objectMemory lengthOf: aSelectorOop).
  	aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
  	self cppIf: NewspeakVM
  		ifTrue: [cogMethod := methodZone findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop.
  				cogMethod ifNotNil:
  					[(coInterpreter methodHasCogMethod: aMethodObj) not ifTrue:
  						[self assert: (coInterpreter rawHeaderOf: aMethodObj) = cogMethod methodHeader.
  						 cogMethod methodObject: aMethodObj.
  						 coInterpreter rawHeaderOf: aMethodObj put: cogMethod asInteger].
  					^cogMethod]].
  	"If the generators for the alternate bytecode set are missing then interpret."
  	(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj)
  		ifTrue:
  			[(self numElementsIn: generatorTable) <= 256 ifTrue:
  				[^nil].
  			 bytecodeSetOffset := 256]
  		ifFalse:
  			[bytecodeSetOffset := 0].
  	objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
  	methodObj := aMethodObj.
  	cogMethod := self compileCogMethod: aSelectorOop.
  	(cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
  		[cogMethod asInteger = InsufficientCodeSpace ifTrue:
  			[coInterpreter callForCogCompiledCodeCompaction].
  		 self maybeFreeCounters.
  		 "Right now no errors should be reported, so nothing more to do."
  		 "self reportError: (self cCoerceSimple: cogMethod to: #sqInt)."
  		 ^nil].
  	"self cCode: ''
  		inSmalltalk:
  			[coInterpreter printCogMethod: cogMethod.
  			 ""coInterpreter symbolicMethod: aMethodObj.""
  			 self assertValidMethodMap: cogMethod."
  			 "self disassembleMethod: cogMethod."
  			 "printInstructions := clickConfirm := true""]."
  	^cogMethod!

Item was changed:
  ----- Method: Cogit>>cogExtendPIC:CaseNMethod:tag:isMNUCase: (in category 'in-line cacheing') -----
  cogExtendPIC: cPIC CaseNMethod: caseNMethod tag: caseNTag isMNUCase: isMNUCase
  	"Extend the cPIC with the supplied case.  If caseNMethod is cogged dispatch direct to
  	 its unchecked entry-point.  If caseNMethod is not cogged, jump to the fast interpreter
  	 dispatch, and if isMNUCase then dispatch to fast MNU invocation and mark the cPIC as
  	 having the MNU case for cache flushing."
   	<var: #cPIC type: #'CogMethod *'>
  	| operand target address size end |
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	coInterpreter
  		compilationBreak: cPIC selector
+ 		point: (objectMemory lengthOf: cPIC selector)
+ 		isMNUCase: isMNUCase.
- 		point: (objectMemory lengthOf: cPIC selector).
  	self allocateOpcodes: 5 bytecodes: 0.
  	self assert: (objectRepresentation inlineCacheTagIsYoung: caseNTag) not.
  	"Caller patches to open pic if caseNMethod is young."
  	self assert: (caseNMethod notNil and: [(objectMemory isYoung: caseNMethod) not]).
  	(isMNUCase not
  	 and: [coInterpreter methodHasCogMethod: caseNMethod])
  		ifTrue:
  			[operand := 0.
  			 target :=  (coInterpreter cogMethodOf: caseNMethod) asInteger + cmNoCheckEntryOffset]
  		ifFalse:
  			[isMNUCase ifTrue:
  				[cPIC cpicHasMNUCase: true].
  			 operand := caseNMethod.
  			 target := cPIC asInteger
  					+ (isMNUCase
  						ifTrue: [self sizeof: CogMethod]
  						ifFalse: [self interpretOffset - backEnd callInstructionByteSize])].
  	self CmpCw: caseNTag R: TempReg.
  	self MoveCw: operand R: SendNumArgsReg.
  	self JumpLongZero: target.
  	self MoveCw: cPIC asInteger R: ClassReg.
  	self JumpLong: (self cPICMissTrampolineFor: cPIC cmNumArgs).
  
  	self computeMaximumSizes.
  	address := self addressOfEndOfCase: cPIC cPICNumCases - 1 inCPIC: cPIC.
  	size := self generateInstructionsAt: address.
  	end := self outputInstructionsAt: address.
  	processor flushICacheFrom: address to: cPIC asInteger + closedPICSize.
  	cPIC cPICNumCases: cPIC cPICNumCases + 1.
  	^0!

Item was changed:
  ----- Method: Cogit>>cogMNUPICSelector:methodOperand:numArgs: (in category 'in-line cacheing') -----
  cogMNUPICSelector: selector methodOperand: methodOperand numArgs: numArgs
  	<api>
  	"Attempt to create a one-case PIC for an MNU.
  	 The tag for the case is at the send site and so doesn't need to be generated."
  	<returnTypeC: #'CogMethod *'>
  	| startAddress headerSize size end |
  	(objectMemory isYoung: selector) ifTrue:
  		[^0].
  	coInterpreter
  		compilationBreak: selector
+ 		point: (objectMemory lengthOf: selector)
+ 		isMNUCase: true.
- 		point: (objectMemory lengthOf: selector).
  	self assert: endCPICCase0 notNil.
  	startAddress := methodZone allocate: closedPICSize.
  	startAddress = 0 ifTrue:
  		[coInterpreter callForCogCompiledCodeCompaction.
  		 ^0].
  	methodLabel
  		address: startAddress;
  		dependent: nil.
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	self allocateOpcodes: numPICCases * 7 bytecodes: 0.
  	self compileMNUCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		methodOperand: methodOperand
  		numArgs: numArgs.
  	self computeMaximumSizes.
  	headerSize := self sizeof: CogMethod.
  	size := self generateInstructionsAt: startAddress + headerSize.
  	end := self outputInstructionsAt: startAddress + headerSize.
  	"The missOffset is the same as the interpretOffset."
  	self assert: missOffset = (interpretCall address + interpretCall machineCodeSize - startAddress).
  	self assert: startAddress + cmEntryOffset = entry address.
  	^self
  		fillInCPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		size: closedPICSize
  		numArgs: numArgs
  		numCases: 1
  		hasMNUCase: true
  		selector: selector !

Item was changed:
  ----- Method: Cogit>>cogOpenPICSelector:numArgs: (in category 'in-line cacheing') -----
  cogOpenPICSelector: selector numArgs: numArgs
  	"Create an Open PIC.  Temporarily create a direct call of ceSendFromOpenPIC:.
  	 Should become a probe of the first-level method lookup cache followed by a
  	 call of ceSendFromOpenPIC: if the probe fails."
  	<returnTypeC: #'CogMethod *'>
  	| startAddress headerSize codeSize mapSize end |
  	coInterpreter
  		compilationBreak: selector
+ 		point: (objectMemory lengthOf: selector)
+ 		isMNUCase: false.
- 		point: (objectMemory lengthOf: selector).
  	startAddress := methodZone allocate: openPICSize.
  	startAddress = 0 ifTrue:
  		[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	methodLabel
  		address: startAddress;
  		dependent: nil.
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	self allocateOpcodes: 100 bytecodes: 0.
  	self compileOpenPIC: selector numArgs: numArgs.
  	self computeMaximumSizes.
  	methodLabel concretizeAt: startAddress.
  	headerSize := self sizeof: CogMethod.
  	codeSize := self generateInstructionsAt: startAddress + headerSize.
  	mapSize := self generateMapAt: startAddress + openPICSize - 1 start: startAddress + cmNoCheckEntryOffset.
  	self assert: entry address - startAddress = cmEntryOffset.
  	self assert: headerSize + codeSize + mapSize <= openPICSize.
  	end := self outputInstructionsAt: startAddress + headerSize.
  	^self
  		fillInOPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		size: openPICSize
  		numArgs: numArgs
  		selector: selector !

Item was changed:
  ----- Method: Cogit>>cogPICSelector:numArgs:Case0Method:Case1Method:tag:isMNUCase: (in category 'in-line cacheing') -----
  cogPICSelector: selector numArgs: numArgs Case0Method: case0CogMethod Case1Method: case1MethodOrNil tag: case1Tag isMNUCase: isMNUCase
  	"Attempt to create a two-case PIC for case0CogMethod and  case1Method,case1Tag.
  	 The tag for case0CogMethod is at the send site and so doesn't need to be generated.
  	 case1Method may be any of
  		- a Cog method; link to its unchecked entry-point
  		- a CompiledMethod; link to ceInterpretMethodFromPIC:
  		- a CompiledMethod; link to ceMNUFromPICMNUMethod:receiver:"
  	<var: #case0CogMethod type: #'CogMethod *'>
  	<returnTypeC: #'CogMethod *'>
  	| startAddress headerSize size end |
  	(objectMemory isYoung: selector) ifTrue:
  		[^self cCoerceSimple: YoungSelectorInPIC to: #'CogMethod *'].
  	coInterpreter
  		compilationBreak: selector
+ 		point: (objectMemory lengthOf: selector)
+ 		isMNUCase: isMNUCase.
- 		point: (objectMemory lengthOf: selector).
  	startAddress := methodZone allocate: closedPICSize.
  	startAddress = 0 ifTrue:
  		[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	methodLabel
  		address: startAddress;
  		dependent: nil.
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	self allocateOpcodes: numPICCases * 7 bytecodes: 0.
  	self compileCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		Case0: case0CogMethod
  		Case1Method: case1MethodOrNil
  		tag: case1Tag
  		isMNUCase: isMNUCase
  		numArgs: numArgs.
  	self computeMaximumSizes.
  	headerSize := self sizeof: CogMethod.
  	size := self generateInstructionsAt: startAddress + headerSize.
  	end := self outputInstructionsAt: startAddress + headerSize.
  	"The missOffset is th same as the interpretOffset."
  	self assert: missOffset = (interpretCall address + interpretCall machineCodeSize - startAddress).
  	self assert: startAddress + cmEntryOffset = entry address.
  	self assert: endCPICCase0 address = (startAddress + firstCPICCaseOffset).
  	self assert: endCPICCase1 address = (startAddress + firstCPICCaseOffset + cPICCaseSize).
  	^self
  		fillInCPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		size: closedPICSize
  		numArgs: numArgs
  		numCases: 2
  		hasMNUCase: isMNUCase
  		selector: selector !

Item was changed:
  ----- Method: Cogit>>setSelectorOf:to: (in category 'jit - api') -----
  setSelectorOf: cogMethod to: aSelectorOop
  	<api>
  	"If a method is compiled to machine code via a block entry it won't have a selector.
  	 A subsequent send can find the method and hence fill in the selector."
  	<var: #cogMethod type: #'CogMethod *'>
  	"self disassembleMethod: cogMethod"
  	coInterpreter
  		compilationBreak: aSelectorOop
+ 		point: (objectMemory lengthOf: aSelectorOop)
+ 		isMNUCase: false.
- 		point: (objectMemory lengthOf: aSelectorOop).
  	self assert: cogMethod cmType = CMMethod.
  	cogMethod selector: aSelectorOop.
  	(objectMemory isYoung: aSelectorOop) ifTrue:
  		[methodZone ensureInYoungReferrers: cogMethod]!

Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>compilationBreak:point: (in category 'debug support') -----
- compilationBreak: aString point: length 
- 	^self!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>compilationBreak:point:isMNUCase: (in category 'debug support') -----
+ compilationBreak: aString point: length isMNUCase: isMNUCase
+ 	^self!



More information about the Vm-dev mailing list