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

commits at source.squeak.org commits at source.squeak.org
Tue Jan 20 23:44:25 UTC 2015


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

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

Name: VMMaker.oscog-eem.1025
Author: eem
Time: 20 January 2015, 3:42:58.815 pm
UUID: 1a29f456-a8e2-4312-a391-8e2cdb0430ee
Ancestors: VMMaker.oscog-eem.1024

Spur: Optionalize some api methods the Spur Cogit
doesn't use.

Make cogCodeConstituents 64-bit ready.

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

Item was changed:
  ----- Method: CoInterpreter>>ceActiveContext (in category 'trampolines') -----
  ceActiveContext
  	<api>
+ 	<option: #SqueakV3ObjectMemory>
  	"Since the trampoline checks for marriage we should only be here for a single frame."
  	self assert: (self isMachineCodeFrame: framePointer).
  	self assert: (self frameHasContext: framePointer) not.
  	"Do *not* include the return pc in the stack contents; hence + BytesPerWord"
  	^self marryFrame: framePointer SP: stackPointer + objectMemory wordSize!

Item was changed:
  ----- Method: CoInterpreter>>ceNewArraySlotSize: (in category 'trampolines') -----
  ceNewArraySlotSize: slotSize
  	<api>
+ 	<option: #SqueakV3ObjectMemory>
  	objectMemory hasSpurMemoryManagerAPI ifTrue:
  		[| obj |
  		 obj := objectMemory
  					eeInstantiateSmallClassIndex: ClassArrayCompactIndex
  					format: objectMemory arrayFormat
  					numSlots: slotSize.
  		objectMemory fillObj: obj numSlots: slotSize with: objectMemory nilObject.
  		^obj].
  	^objectMemory
  		eeInstantiateAndInitializeClass: (objectMemory splObj: ClassArray)
  		indexableSize: slotSize!

Item was changed:
  ----- Method: CoInterpreter>>createClosureNumArgs:numCopied:startpc: (in category 'trampolines') -----
  createClosureNumArgs: numArgs numCopied: numCopied startpc: initialIP
  	<api>
+ 	<option: #SqueakV3ObjectMemory>
  	| context newClosure |
  	self assert: (self isMachineCodeFrame: framePointer).
  	"Do *not* include the return pc or copied values in the stack contents;
  	 hence + ((1 + numCopied) * BytesPerWord)"
  	context := self ensureFrameIsMarried: framePointer
  					SP: stackPointer + ((1 + numCopied) * objectMemory wordSize).
  	newClosure := self
  					closureIn: context
  					numArgs: numArgs
  					instructionPointer: initialIP
  					numCopiedValues: numCopied.
  	cogit recordSendTrace ifTrue:
  		[self recordTrace: TraceBlockCreation thing: newClosure source: TraceIsFromMachineCode].
  	numCopied > 0 ifTrue:
  		["N.B. the expression ((numCopied - i) * BytesPerWord)) skips the return address"
  		 0 to: numCopied - 1 do:
  			[:i|
  			"Assume: have just allocated a new BlockClosure; it must be young.
  			 Thus, can use unchecked stores."
  			 objectMemory storePointerUnchecked: i + ClosureFirstCopiedValueIndex
  				ofObject: newClosure
  				withValue: (stackPages longAt: stackPointer + ((numCopied - i) * objectMemory wordSize))]].
  	"Assume caller will pop stack"
  	^newClosure!

Item was added:
+ ----- Method: CogMethodZone>>zoneFree (in category 'accessing') -----
+ zoneFree
+ 	<inline: true>
+ 	^mzFreeStart!

Item was changed:
  ----- Method: Cogit>>cogCodeConstituents (in category 'profiling primitives') -----
  cogCodeConstituents
  	"Answer the contents of the code zone as an array of pair-wise element, address in ascending address order.
  	 Answer a string for a runtime routine or abstract label (beginning, end, etc), a CompiledMethod for a CMMethod,
  	 or a selector (presumably a Symbol) for a PIC."
  	<api>
  	| count cogMethod constituents label value |
  	<var: #cogMethod type: #'CogMethod *'>
  	count := trampolineTableIndex / 2 + 3. "+ 3 for start, freeStart and end"
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType ~= CMFree ifTrue:
  			[count := count + 1].
  		cogMethod := methodZone methodAfter: cogMethod].
  	constituents := coInterpreter instantiateClass: coInterpreter classArray indexableSize: count * 2.
  	constituents isNil ifTrue:
  		[^constituents].
  	coInterpreter pushRemappableOop: constituents.
  	((label := objectMemory stringForCString: 'CogCode') isNil
+ 	 or: [(value := self positiveMachineIntegerFor: codeBase) isNil]) ifTrue:
- 	 or: [(value := coInterpreter positive32BitIntegerFor: codeBase) isNil]) ifTrue:
  		[^nil].
  	coInterpreter
  		storePointerUnchecked: 0 ofObject: coInterpreter topRemappableOop withValue: label;
  		storePointerUnchecked: 1 ofObject: coInterpreter topRemappableOop withValue: value.
  	0 to: trampolineTableIndex - 1 by: 2 do:
  		[:i|
  		((label := objectMemory stringForCString: (trampolineAddresses at: i)) isNil
+ 		 or: [(value := self positiveMachineIntegerFor: (trampolineAddresses at: i + 1) asUnsignedInteger) isNil]) ifTrue:
- 		 or: [(value := coInterpreter positive32BitIntegerFor: (trampolineAddresses at: i + 1) asUnsignedInteger) isNil]) ifTrue:
  			[coInterpreter popRemappableOop.
  			 ^nil].
  		coInterpreter
  			storePointerUnchecked: 2 + i ofObject: coInterpreter topRemappableOop withValue: label;
  			storePointerUnchecked: 3 + i ofObject: coInterpreter topRemappableOop withValue: value].
  	count := trampolineTableIndex + 2.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType ~= CMFree ifTrue:
  			[coInterpreter
  				storePointerUnchecked: count
  				ofObject: coInterpreter topRemappableOop
  				withValue: (cogMethod cmType = CMMethod
  								ifTrue: [cogMethod methodObject]
  								ifFalse: [cogMethod selector]).
+ 			 (value := self positiveMachineIntegerFor: cogMethod asUnsignedInteger) isNil ifTrue:
- 			 (value := coInterpreter positive32BitIntegerFor: cogMethod asUnsignedInteger) isNil ifTrue:
  				[coInterpreter popRemappableOop.
  				 ^nil].
  			 coInterpreter
  				storePointerUnchecked: count + 1
  				ofObject: coInterpreter topRemappableOop
  				withValue: value.
  			 count := count + 2].
  		cogMethod := methodZone methodAfter: cogMethod].
  	((label := objectMemory stringForCString: 'CCFree') isNil
+ 	 or: [(value := self positiveMachineIntegerFor: methodZone zoneFree) isNil]) ifTrue:
- 	 or: [(value := coInterpreter positive32BitIntegerFor: methodZone freeStart) isNil]) ifTrue:
  		[coInterpreter popRemappableOop.
  		 ^nil].
  	coInterpreter
  		storePointerUnchecked: count ofObject: coInterpreter topRemappableOop withValue: label;
  		storePointerUnchecked: count + 1 ofObject: coInterpreter topRemappableOop withValue: value.
  	((label := objectMemory stringForCString: 'CCEnd') isNil
+ 	 or: [(value := self positiveMachineIntegerFor: methodZone zoneEnd) isNil]) ifTrue:
- 	 or: [(value := coInterpreter positive32BitIntegerFor: methodZone zoneEnd) isNil]) ifTrue:
  		[coInterpreter popRemappableOop.
  		 ^nil].
  	coInterpreter
  		storePointerUnchecked: count + 2 ofObject: coInterpreter topRemappableOop withValue: label;
  		storePointerUnchecked: count + 3 ofObject: coInterpreter topRemappableOop withValue: value.
  	constituents := coInterpreter popRemappableOop.
  	coInterpreter beRootIfOld: constituents.
  	^constituents!

Item was added:
+ ----- Method: Cogit>>positiveMachineIntegerFor: (in category 'profiling primitives') -----
+ positiveMachineIntegerFor: value
+ 	<var: #value type: #'unsigned long'>
+ 	<inline: true>
+ 	^objectMemory wordSize = 8
+ 		ifTrue: [coInterpreter positive64BitIntegerFor: value]
+ 		ifFalse: [coInterpreter positive32BitIntegerFor: value]!

Item was changed:
  ----- Method: InterpreterPlugin>>positiveMachineIntegerFor: (in category 'API access') -----
  positiveMachineIntegerFor: value
  	<var: #value type: #'unsigned long'>
  	<inline: true>
+ 	^interpreterProxy wordSize = 8
- 	^interpreterProxy bytesPerWord = 8
  		ifTrue: [interpreterProxy positive64BitIntegerFor: value]
  		ifFalse: [interpreterProxy positive32BitIntegerFor: value]!

Item was changed:
  ----- Method: InterpreterPlugin>>signedMachineIntegerFor: (in category 'API access') -----
  signedMachineIntegerFor: value
  	<var: #value type: #'unsigned long'>
  	<inline: true>
+ 	^interpreterProxy wordSize = 8
- 	^interpreterProxy bytesPerWord = 8
  		ifTrue: [interpreterProxy signed64BitIntegerFor: value]
  		ifFalse: [interpreterProxy signed32BitIntegerFor: value]!

Item was changed:
  ----- Method: InterpreterProxy>>positive64BitIntegerFor: (in category 'converting') -----
  positive64BitIntegerFor: integerValue
+ 	<api>
  	<returnTypeC: #sqInt> "...because answering the 64-bit argument causes the type inferencer to say this answers 64-bits."
  	<var: 'integerValue' type: #sqLong>
  	integerValue isInteger ifFalse:[self error:'Not an Integer object'].
  	^integerValue > 0
  		ifTrue:[integerValue]
  		ifFalse:[ (1 bitShift: 64) + integerValue]!

Item was changed:
  ----- Method: StackInterpreter>>followLiteral:ofMethod: (in category 'compiled methods') -----
  followLiteral: offset ofMethod: methodPointer
- 	<api>
  	^objectMemory followField: offset + LiteralStart ofObject: methodPointer
  !



More information about the Vm-dev mailing list