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

commits at source.squeak.org commits at source.squeak.org
Mon Jan 7 17:43:07 UTC 2013


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

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

Name: VMMaker.oscog-eem.249
Author: eem
Time: 7 January 2013, 9:40:44.287 am
UUID: f55f4646-2800-4e27-b885-c25b0eddd43e
Ancestors: VMMaker.oscog-eem.248

Implement absent receiver sends in the Cogits.
Refactor pushImplicitReceiver into genGetImplicitReceiverFor: and
clients and use genGetImplicitReceiverFor: for absent receiver sends.
No longer use Arg0Reg in ceImplicitReceiverTrampoline.
Fix CurrentImageCoInterpreterFacade for Newspeak methods.
Fix initialization of COGMTVM for simulation.

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

Item was changed:
  ----- Method: Cogit>>generateNewspeakRuntime (in category 'initialization') -----
  generateNewspeakRuntime
  	<option: #NewspeakVM>
  	| jumpMiss jumpItsTheReceiverStupid |
  	<var: #jumpMiss type: #'AbstractInstruction *'>
  	<var: #jumpItsTheReceiverStupid type: #'AbstractInstruction *'>
  	"Generate the non-send runtime support for Newspeak, explicit outer and implicit receiver.
  	 The dynamic frequency of explicit outer is so low we merely call an interpreter routine."
  	ceExplicitReceiverTrampoline := self genTrampolineFor: #ceExplicitReceiverAt:
  										called: 'ceExplicitReceiverTrampoline'
  										arg: SendNumArgsReg
  										result: ReceiverResultReg.
  	"Cached push implicit receiver implementation.  Caller looks like
  				mov selector, ClassReg
  				call ceImplicitReceiver
  				br continue
  		Lclass:	.word
  		Lmixin::	.word
  		continue:
  	 If class matches class of receiver then mixin contains either 0 or the implicit receiver.
  	 If 0, answer the actual receiver, otherwise the mixin.
+ 	 Generate the class fetch and cache probe inline for speed. Smashes caller-saved regs."
- 	 Generate the class fetch and cache probe inline for speed. Smashes Arg0Reg and caller-saved regs."
  	opcodeIndex := 0.
  	self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  	objectRepresentation genGetClassObjectOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
+ 	self MoveMw: 0 r: SPReg R: TempReg. "get return address..."
+ 	self MoveMw: backEnd jumpShortByteSize r: TempReg R: ReceiverResultReg. "get cached class..."
+ 	self CmpR: ClassReg R: ReceiverResultReg.
- 	self MoveMw: 0 r: SPReg R: TempReg.
- 	self MoveMw: backEnd jumpShortByteSize r: TempReg R: Arg0Reg.
- 	self CmpR: ClassReg R: Arg0Reg.
  	jumpMiss := self JumpNonZero: 0.
  	self MoveMw: backEnd jumpShortByteSize + BytesPerOop r: TempReg R: ClassReg.
  	self CmpCq: 0 R: ClassReg.
  	jumpItsTheReceiverStupid := self JumpZero: 0.
  	self MoveR: ClassReg R: ReceiverResultReg.
  	jumpItsTheReceiverStupid jmpTarget: (self RetN: 0).
  	jumpMiss jmpTarget: self Label.
  	ceImplicitReceiverTrampoline := self
  										genTrampolineFor: #ceImplicitReceiverFor:receiver:class:
  										called: 'ceImplicitReceiverTrampoline'
  										callJumpBar: true
  										numArgs: 3
  										arg: SendNumArgsReg
  										arg: ReceiverResultReg
  										arg: ClassReg
  										arg: nil
  										saveRegs: false
  										resultReg: ReceiverResultReg
  										appendOpcodes: true!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>debugStackPointersFor: (in category 'accessing') -----
  debugStackPointersFor: anOop
  	^CArrayAccessor on:
+ 		(((NewspeakVM
+ 				ifTrue: [NewspeakStackDepthFinder]
+ 				ifFalse: [StackDepthFinder]) on: (objectMap keyAtValue: anOop))
- 		((StackDepthFinder on: (objectMap keyAtValue: anOop))
  			stackPointers)!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>splObj: (in category 'accessing') -----
  splObj: splObjIndex
  	^splObjIndex caseOf: {
+ 		[ClassArray]		-> [self oopForObject: Array].
+ 		[CompactClasses]	-> [self oopForObject: Smalltalk compactClassesArray]
+ 		}!
- 		[ClassArray] -> [self oopForObject: Array] }!

Item was added:
+ ----- Method: NewspeakStackDepthFinder>>sendToAbsentImplicitReceiver:numArgs: (in category 'instruction decoding') -----
+ sendToAbsentImplicitReceiver: selector numArgs: numArgs
+ 	"Send Message With Selector, selector, to dynamic superclass bytecode."
+ 	self drop: numArgs - 1 "i.e. if 0 args, pushes a result"!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genExtSendAbsentImplicitBytecode (in category 'bytecode generators') -----
  genExtSendAbsentImplicitBytecode
  	"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"
+ 	| litIndex nArgs |
+ 	litIndex := (byte1 >> 3) + (extA << 5).
+ 	extA := 0.
+ 	nArgs := (byte1 bitAnd: 7) + (extB << 3).
+ 	extB := 0.
+ 	^self genSendAbsentImplicit: (coInterpreter literal: litIndex ofMethod: methodObj) numArgs: nArgs!
- 	self shouldBeImplemented.
- 	^EncounteredUnknownBytecode!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genGetImplicitReceiverFor: (in category 'bytecode generators') -----
+ genGetImplicitReceiverFor: selector
+ 	"Cached implicit receiver implementation.  Caller looks like
+ 		mov selector, ClassReg
+ 				call cePushImplicitReceiver
+ 				br continue
+ 		Lclass	.word
+ 		Lmixin:	.word
+ 		continue:
+ 	 If class matches class of receiver then mixin contains either 0 or the implicit receiver.
+ 	 If 0, answer the actual receiver.  This is done in the trampoline.
+ 	 See generateNewspeakRuntime."
+ 	| skip |
+ 	<var: #skip type: #'AbstractInstruction *'>
+ 	(objectMemory isYoung: selector) ifTrue:
+ 		[hasYoungReferent := true].
+ 	self assert: needsFrame.
+ 	self MoveCw: selector R: SendNumArgsReg.
+ 	self CallNewspeakSend: ceImplicitReceiverTrampoline.
+ 	skip := self Jump: 0.
+ 	self Fill32: 0.
+ 	self Fill32: 0.
+ 	skip jmpTarget: self Label.
+ 	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPushImplicitReceiverBytecode (in category 'bytecode generators') -----
  genPushImplicitReceiverBytecode
+ 	| result |
+ 	result := self genGetImplicitReceiverFor: (coInterpreter literal: byte1 ofMethod: methodObj).
+ 	result ~= 0 ifTrue:
+ 		[^result].
+ 	self PushR: ReceiverResultReg.
- 	"Cached push implicit receiver implementation.  Caller looks like
- 		mov selector, ClassReg
- 				call cePushImplicitReceiver
- 				br continue
- 		Lclass	.word
- 		Lmixin:	.word
- 		continue:
- 	 If class matches class of receiver then mixin contains either 0 or the implicit receiver.
- 	 If 0, push the actual receiver."
- 	| selector skip |
- 	<var: #skip type: #'AbstractInstruction *'>
- 
- 	selector := coInterpreter literal: byte1 ofMethod: methodObj.
- 	(objectMemory isYoung: selector) ifTrue:
- 		[hasYoungReferent := true].
- 	self assert: needsFrame.
- 	self MoveCw: selector R: SendNumArgsReg.
- 	self CallNewspeakSend: ceImplicitReceiverTrampoline.
- 	skip := self Jump: 0.
- 	self Fill32: 0.
- 	self Fill32: 0.
- 	skip jmpTarget: (self PushR: ReceiverResultReg).
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genSendAbsentImplicit0ArgsBytecode (in category 'bytecode generators') -----
  genSendAbsentImplicit0ArgsBytecode
+ 	"160-175	1010 i i i i		Send To Absent Implicit Receiver Literal Selector #iiii With 0 Arguments."
+ 	^self genSendAbsentImplicit: (coInterpreter literal: (byte0 bitAnd: 15) ofMethod: methodObj) numArgs: 0!
- 	"160-175	1010 i i i i		Send To Absent Implicit Receiver Literal Selector #iiii With 0 Arguments"
- 	self shouldBeImplemented.
- 	^EncounteredUnknownBytecode!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genSendAbsentImplicit:numArgs: (in category 'bytecode generators') -----
+ genSendAbsentImplicit: selector numArgs: numArgs
+ 	"Get the implicit receiver and shuffle arguments if necessary.
+ 	 Then send."
+ 	<inline: false>
+ 	| result |
+ 	result := self genGetImplicitReceiverFor: selector.
+ 	result ~= 0 ifTrue:
+ 		[^result].
+ 	numArgs = 0
+ 		ifTrue:
+ 			[self PushR: ReceiverResultReg]
+ 		ifFalse:
+ 			[self MoveMw: 0 r: SPReg R: TempReg.
+ 			self PushR: TempReg.
+ 			2 to: numArgs do:
+ 				[:index|
+ 				self MoveMw: index * BytesPerWord r: SPReg R: TempReg.
+ 				self MoveR: TempReg Mw: index - 1 * BytesPerWord r: SPReg].
+ 			"if we copied the code in genSend:numArgs: we could save an instruction.
+ 			But we care not; the smarts are in StackToRegisterMappingCogit et al"
+ 			self MoveR: ReceiverResultReg Mw: numArgs * BytesPerWord r: SPReg].
+ 	^self genSend: selector numArgs: numArgs!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genGetImplicitReceiverFor: (in category 'bytecode generators') -----
+ genGetImplicitReceiverFor: selector
+ 	"Cached implicit receiver implementation.  Caller looks like
+ 		mov selector, ClassReg
+ 				call cePushImplicitReceiver
+ 				br continue
+ 		Lclass	.word
+ 		Lmixin:	.word
+ 		continue:
+ 	 If class matches class of receiver then mixin contains either 0 or the implicit receiver.
+ 	 If 0, answer the actual receiver.  This is done in the trampoline.
+ 	 See generateNewspeakRuntime."
+ 	self ssAllocateCallReg: SendNumArgsReg and: ReceiverResultReg and: ClassReg.
+ 	^super genGetImplicitReceiverFor: selector!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushImplicitReceiverBytecode (in category 'bytecode generators') -----
  genPushImplicitReceiverBytecode
+ 	| result |
+ 	result := self genGetImplicitReceiverFor: (coInterpreter literal: byte1 ofMethod: methodObj).
+ 	result ~= 0 ifTrue:
+ 		[^result].
- 	"Cached push implicit receiver implementation.  Caller looks like
- 		mov selector, ClassReg
- 				call cePushImplicitReceiver
- 				br continue
- 		Lclass	.word
- 		Lmixin:	.word
- 		continue:
- 	 If class matches class of receiver then mixin contains either 0 or the implicit receiver.
- 	 If 0, push the actual receiver."
- 	| selector skip |
- 	<var: #skip type: #'AbstractInstruction *'>
- 	self ssAllocateCallReg: SendNumArgsReg and: ReceiverResultReg and: ClassReg and: Arg0Reg.
- 	selector := coInterpreter literal: byte1 ofMethod: methodObj.
- 	(objectMemory isYoung: selector) ifTrue:
- 		[hasYoungReferent := true].
- 	self assert: needsFrame.
- 	self MoveCw: selector R: SendNumArgsReg.
- 	self CallNewspeakSend: ceImplicitReceiverTrampoline.
- 	skip := self Jump: 0.
- 	self Fill32: 0.
- 	self Fill32: 0.
- 	skip jmpTarget: self Label.
  	^self ssPushRegister: ReceiverResultReg!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genSendAbsentImplicit:numArgs: (in category 'bytecode generators') -----
+ genSendAbsentImplicit: selector numArgs: numArgs
+ 	"Get the implicit receiver and marshall arguments, shuffling the
+ 	 stack to push the implicit receiver if necessary. Then send."
+ 	<inline: false>
+ 	| result |
+ 	result := self genGetImplicitReceiverFor: selector.
+ 	result ~= 0 ifTrue:
+ 		[^result].
+ 	self marshallImplicitReceiverSendArguments: numArgs.
+ 	^self genMarshalledSend: selector numArgs: numArgs!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>marshallImplicitReceiverSendArguments: (in category 'simulation stack') -----
+ marshallImplicitReceiverSendArguments: numArgs
+ 	"Spill everything on the simulated stack that needs spilling (that below arguments).
+ 	 Marshall arguments to stack and/or registers depending on arg count.
+ 	 If the args don't fit in registers push receiver and args (spill everything).  Assume
+ 	 receiver already in ResultReceiverReg so shuffle args and push it if necessary."
+ 	numArgs > self numRegArgs
+ 		ifTrue:
+ 			["The arguments must be pushed to the stack, and hence the receiver
+ 			   must be inserted beneath the args.  If nothing has been spilled first
+ 			   avoid the argument shuffle by pushing ReceiverResultReg first."
+ 			 (self noSpillsInTopNItems: numArgs)
+ 				ifTrue:
+ 					[self PushR: ReceiverResultReg.
+ 					 self ssFlushTo: simStackPtr]
+ 				ifFalse:
+ 					[self ssFlushTo: simStackPtr.
+ 					 self MoveMw: 0 r: SPReg R: TempReg.
+ 					 self PushR: TempReg.
+ 					 2 to: numArgs do:
+ 						[:index|
+ 						self MoveMw: index * BytesPerWord r: SPReg R: TempReg.
+ 						self MoveR: TempReg Mw: index - 1 * BytesPerWord r: SPReg].
+ 					 self MoveR: ReceiverResultReg Mw: numArgs * BytesPerWord r: SPReg]]
+ 		"Move the args to the register arguments, being careful to do
+ 		 so last to first so e.g. previous contents don't get overwritten.
+ 		 Also check for any arg registers in use by other args."
+ 		ifFalse:
+ 			[self ssFlushTo: simStackPtr - numArgs - 1.
+ 			 numArgs > 0 ifTrue:
+ 				[(self numRegArgs > 1 and: [numArgs > 1])
+ 					ifTrue:
+ 						[self ssAllocateRequiredReg: Arg0Reg upThrough: simStackPtr - 2.
+ 						 self ssAllocateRequiredReg: Arg1Reg upThrough: simStackPtr - 1]
+ 					ifFalse:
+ 						[self ssAllocateRequiredReg: Arg0Reg upThrough: simStackPtr - 1]].
+ 			 (self numRegArgs > 1 and: [numArgs > 1]) ifTrue:
+ 				[(self simStackAt: simStackPtr) popToReg: Arg1Reg].
+ 			 numArgs > 0 ifTrue:
+ 				[(self simStackAt: simStackPtr - numArgs + 1)
+ 					popToReg: Arg0Reg]].
+ 	self ssPop: numArgs!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>noSpillsInTopNItems: (in category 'simulation stack') -----
+ noSpillsInTopNItems: n
+ 	"Answer if the simStack contains no spills in the top n items."
+ 	0 to: n - 1 do:
+ 		[:i| (self simStackAt: i) type = SSSpill ifTrue: [^false]].
+ 	^true!

Item was changed:
  ----- Method: VMClass class>>initializeMiscConstantsWith: (in category 'initialization') -----
  initializeMiscConstantsWith: optionsDictionary
  	"Falsify the `what type of VM is this?' flags that are defined in the various interp.h files,
  	 or in the case of VMBIGENDIAN the various sqConfig.h files.
  	 Subclass implementations need to include a super initializeMiscConstantsWith:."
  
  	VMBIGENDIAN class. "Mention this for the benefit of CCodeGenerator>>emitCConstantsOn:"
  	self isInterpreterClass ifTrue:
  		[STACKVM := COGVM := COGMTVM := false].
  	NewspeakVM := optionsDictionary at: #NewspeakVM ifAbsent: [false].
  	MULTIPLEBYTECODESETS := optionsDictionary at: #MULTIPLEBYTECODESETS ifAbsent: [false].
  	"N.B.  Not yet implemented."
+ 	IMMUTABILITY := optionsDictionary at: #IMMUTABILITY ifAbsent: [false].
+ 
+ 	"These for scripts etc... Usually they should get set by an Interpreter class's initializeMiscConstantsWith:"
+ 	(optionsDictionary includesKey: #STACKVM) ifTrue:
+ 		[STACKVM := optionsDictionary at: #STACKVM].
+ 	(optionsDictionary includesKey: #COGVM) ifTrue:
+ 		[COGVM := optionsDictionary at: #COGVM].
+ 	(optionsDictionary includesKey: #COGMTVM) ifTrue:
+ 		[COGMTVM := optionsDictionary at: #COGMTVM]!
- 	IMMUTABILITY := optionsDictionary at: #IMMUTABILITY ifAbsent: [false]!



More information about the Vm-dev mailing list