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

commits at source.squeak.org commits at source.squeak.org
Fri Jul 2 14:13:27 UTC 2021


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

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

Name: VMMaker.oscog-eem.2977
Author: eem
Time: 2 July 2021, 7:13:18.710307 am
UUID: cecbc82f-8b01-4ca2-83b5-fd2049793234
Ancestors: VMMaker.oscog-eem.2976

Fix symbolicMethod: for full lbocks.
Commentary.

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

Item was changed:
  ----- Method: CogARMv8Compiler>>concretizeMulOverflowJump (in category 'generate machine code - concretize processor-specific') -----
  concretizeMulOverflowJump
- 	"Will get inlined into concretizeAt: switch."
  	"Sizing/generating jumps.
  		Jump targets can be to absolute addresses or other abstract instructions.
  		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
  		Otherwise instructions must have a machineCodeSize which must be kept to."
  	<inline: false>
  	| offset |
  	offset := self computeJumpTargetOffset - 4. "-4 because the jump is from the second word..."
   	self assert: (offset ~= 0 and: [self isInImmediateBranchRange: offset]).
  	"See concretizeMulOverflowRRR
  	 RISCTempReg := RISCTempReg + CArg1Reg/sign.
  	 JumpZero/NonZero"
  	machineCode
  		at: 0
  		put: 2r10001011 << 24
  			+ (ArithmeticAddS << 29)
  			+ (CArg1Reg << 16)
  			+ (RISCTempReg << 5)
  			+ RISCTempReg;
  		at: 1
  		put: (self
  				cond: (opcode = JumpMulOverflow ifTrue: [NE] ifFalse: [EQ])
  				offset: offset). "B offset"
  	^8!

Item was changed:
  ----- Method: CogARMv8Compiler>>concretizeMulOverflowRRR (in category 'generate machine code - concretize processor-specific') -----
  concretizeMulOverflowRRR
+ 	"Will get inlined into concretizeAt: switch."
  	"ARMv8 has no multiply overflow detection.  Instead it is synthesized from the two halves of
  	 a 64x64=>128 bit multiply. The upper 64-bits are tested.  The sequence is
- 		low64 := MUL a,b
  		high64 := SMULH a,b
+ 		a/low64 := MUL a,b
+ 		signBit := low64/a >> 63
- 		signBit := low64 >> 63
  		high64 := high64 + signBit
+ 	 If high64 is zero after this sequence then the multiply has not overflowed,
+ 	 since high64 is an extension of signBit if no overflow (either 0 or -1) and
+ 	 both -1 + 1 = 0 and 0 + 0 = 0. Note that because we restrict ourselves to
+ 	 three concrete ARMv8 instructions per abstract instruction the last operation
+ 	 of the sequence is generated in concretizeMulOverflowJump.
- 	 If high64 is zero after this sequence then the multiply has not overflowed, since
- 	 high64 is an extension of signBit if no overflow (either 0 or -1) and -1 + 1 = 0.
- 	 However, since we restrict ourselves to three concrete ARMv8 instructions per abstract instruction
- 	 we move the last operation of the sequence to concretizeMulOverflowJump
  
  	 C6.2.196	MUL				C6-1111
  	 C6.2.242	SMULH				C6-1184
  	 C6.2.180	LSR (immediate)	C6-1081	110100110 (1)"
  
  	<inline: true>
  	| reg1 reg2 reg3 |
  	reg1 := operands at: 0.
  	reg2 := operands at: 1.
  	reg3 := operands at: 2.
+ 	"RISCTempReg := high(reg1 * reg2); must precede destructive MUL"
- 	"RISCTempReg := high(reg1 * reg2); must orecede destructive MUL"
  	machineCode
  		at: 0
  		put: 2r1001101101 << 22
  			+ (reg1 << 16)
  			+ (XZR << 10)
  			+ (reg2 << 5)
  			+ RISCTempReg.
  	"reg3 := reg1 * reg2"
  	machineCode
  		at: 1
  		put: 2r10011011 << 24
  			+ (reg1 << 16)
  			+ (XZR << 10)
  			+ (reg2 << 5)
  			+ reg3.
  	"CArg1Reg := sign(reg3)"
  	machineCode
  		at: 2
  		put: 2r1101001101 << 22
  			+ (63 << 16) "constant to shift by"
  			+ (63 << 10)
  			+ (reg3 << 5)
  			+ CArg1Reg. "cuz CArg0Reg == TempReg"
  	"RISCTempReg := RISCTempReg + CArg1Reg/sign
  	 is in concretizeMulOverflowJump"
  	"cogit processor disassembleInstructionAt: 0 In: machineCode object"
  	"cogit processor disassembleInstructionAt: 4 In: machineCode object"
  	"cogit processor disassembleInstructionAt: 8 In: machineCode object"
  	^12!

Item was added:
+ ----- Method: InterpreterPrimitives>>isInstanceOfClassFullBlockClosure: (in category 'primitive support') -----
+ isInstanceOfClassFullBlockClosure: oop
+ 	<inline: true>
+ 	"N.B.  Because Slang always inlines is:instanceOf:compactClassIndex:
+ 	 (because is:instanceOf:compactClassIndex: has an inline: pragma) the
+ 	 phrase (objectMemory splObj: ClassFullBlockClosure) is expanded in-place
+ 	 and is _not_ evaluated if oop has a non-zero CompactClassIndex."
+ 	^objectMemory
+ 		is: oop
+ 		instanceOf: (objectMemory splObj: ClassFullBlockClosure) 
+ 		compactClassIndex: ClassFullBlockClosureCompactIndex!

Item was changed:
  VMObjectProxy subclass: #VMCompiledMethodProxy
+ 	instanceVariableNames: 'size numLiterals literals'
- 	instanceVariableNames: 'size numLiterals'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-Support'!
  
+ !VMCompiledMethodProxy commentStamp: 'eem 8/6/2014 14:48' prior: 0!
- !VMCompiledMethodProxy commentStamp: '' prior: 0!
  A VMCompiledMethodProxy is a wrapper for the oop of a CompiledMethod object in the simulator VM's heap that provides accessd to the oop as if it were a CompiledMethod object.!

Item was changed:
  ----- Method: VMCompiledMethodProxy>>literalAt: (in category 'literals') -----
  literalAt: index 
+ 	^self literals at: index!
- 	^VMObjectProxy new
- 		for: (coInterpreter literal: index - 1 ofMethod: oop)
- 		coInterpreter: coInterpreter
- 		objectMemory: objectMemory;
- 		printPretty: printPretty;
- 		yourself!

Item was added:
+ ----- Method: VMCompiledMethodProxy>>literals (in category 'accessing') -----
+ literals
+ 	literals ifNil:
+ 		[literals := (1 to: self numLiterals) collect:
+ 						[:litIndex|
+ 						((objectMemory isCompiledMethod: oop)
+ 								ifTrue: [VMCompiledMethodProxy]
+ 								ifFalse: [VMObjectProxy]) new
+ 							for: (coInterpreter literal: litIndex - 1 ofMethod: oop)
+ 							coInterpreter: coInterpreter
+ 							objectMemory: objectMemory;
+ 							printPretty: printPretty;
+ 							yourself]].
+ 	^literals!

Item was added:
+ ----- Method: VMObjectProxy>>numArgs (in category 'accessing') -----
+ numArgs
+ 	^((coInterpreter isInstanceOfClassBlockClosure: oop)
+ 	or: [coInterpreter isInstanceOfClassFullBlockClosure: oop]) ifTrue:
+ 		[coInterpreter argumentCountOfClosure: oop]!



More information about the Vm-dev mailing list