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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 27 02:16:39 UTC 2016


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

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

Name: VMMaker.oscog-eem.1952
Author: eem
Time: 26 September 2016, 7:14:52.614044 pm
UUID: 79e61495-26b7-4fcd-9020-f792178fd68e
Ancestors: VMMaker.oscog-rsf.1951

Revise CogIA32Compiler>>dispatchConcretize to cimpile in Squeak V3 (pull out processor specific opcodes into their own routine). 

Fix slip in CogSimStackNativeEntry class>>instVarNamesAndTypesForTranslationDo:

Make VMProfileMacSupportPlugin support 64-biuts (at least for collecting modules).

=============== Diff against VMMaker.oscog-rsf.1951 ===============

Item was changed:
  ----- Method: CogIA32Compiler>>dispatchConcretize (in category 'generate machine code') -----
  dispatchConcretize
  	"Attempt to generate concrete machine code for the instruction at address.
  	 This is the inner dispatch of concretizeAt: actualAddress which exists only
  	 to get around the branch size limits in the SqueakV3 (blue book derived)
  	 bytecode set."
  	<returnTypeC: #void>
+ 	opcode >= CDQ ifTrue:
+ 		[^self dispatchConcretizeProcessorSpecific].
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]				-> [^self concretizeLabel].
  		[AlignmentNops]	-> [^self concretizeAlignmentNops].
  		[Fill32]				-> [^self concretizeFill32].
  		[Nop]				-> [^self concretizeNop].
- 		"Specific Control/Data Movement"
- 		[CDQ]					-> [^self concretizeCDQ].
- 		[IDIVR]					-> [^self concretizeIDIVR].
- 		[IMULRR]				-> [^self concretizeMulRR].
- 		[CPUID]					-> [^self concretizeCPUID].
- 		[CMPXCHGAwR]			-> [^self concretizeCMPXCHGAwR].
- 		[CMPXCHGMwrR]		-> [^self concretizeCMPXCHGMwrR].
- 		[LFENCE]				-> [^self concretizeFENCE: 5].
- 		[MFENCE]				-> [^self concretizeFENCE: 6].
- 		[SFENCE]				-> [^self concretizeFENCE: 7].
- 		[LOCK]					-> [^self concretizeLOCK].
- 		[XCHGAwR]				-> [^self concretizeXCHGAwR].
- 		[XCHGMwrR]			-> [^self concretizeXCHGMwrR].
- 		[XCHGRR]				-> [^self concretizeXCHGRR].
- 		[FSTPS]					-> [^self concretizeFSTPS].
- 		[FSTPD]					-> [^self concretizeFSTPD].
  		"Control"
  		[Call]					-> [^self concretizeCall].
  		[CallR]					-> [^self concretizeCallR].
  		[CallFull]				-> [^self concretizeCall].
+ 		[JumpR]				-> [^self concretizeJumpR].
- 		[JumpR]					-> [^self concretizeJumpR].
  		[JumpFull]				-> [^self concretizeJumpLong].
+ 		[JumpLong]			-> [^self concretizeJumpLong].
- 		[JumpLong]				-> [^self concretizeJumpLong].
  		[JumpLongZero]		-> [^self concretizeConditionalJump: 16r4].
  		[JumpLongNonZero]	-> [^self concretizeConditionalJump: 16r5].
  		[Jump]					-> [^self concretizeJump].
  		"Table B-1 Intel® 64 and IA-32 Architectures Software Developer's Manual Volume 1: Basic Architecture"
  		[JumpZero]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpNonZero]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpNegative]			-> [^self concretizeConditionalJump: 16r8].
  		[JumpNonNegative]		-> [^self concretizeConditionalJump: 16r9].
  		[JumpOverflow]			-> [^self concretizeConditionalJump: 16r0].
  		[JumpNoOverflow]		-> [^self concretizeConditionalJump: 16r1].
  		[JumpCarry]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpNoCarry]			-> [^self concretizeConditionalJump: 16r3].
  		[JumpLess]				-> [^self concretizeConditionalJump: 16rC].
  		[JumpGreaterOrEqual]	-> [^self concretizeConditionalJump: 16rD].
  		[JumpGreater]			-> [^self concretizeConditionalJump: 16rF].
  		[JumpLessOrEqual]		-> [^self concretizeConditionalJump: 16rE].
  		[JumpBelow]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpAboveOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpAbove]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpBelowOrEqual]	-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPEqual]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpFPNotEqual]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpFPLess]				-> [^self concretizeConditionalJump: 16r2].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpFPGreater]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpFPLessOrEqual]		-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPOrdered]			-> [^self concretizeConditionalJump: 16rB].
  		[JumpFPUnordered]			-> [^self concretizeConditionalJump: 16rA].
  		[RetN]						-> [^self concretizeRetN].
  		[Stop]						-> [^self concretizeStop].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeAddCqR].
  		[AddCwR]					-> [^self concretizeAddCwR].
+ 		[AddRR]					-> [^self concretizeOpRR: 16r03].
- 		[AddRR]						-> [^self concretizeOpRR: 16r03].
  		[AddcRR]					-> [^self concretizeAddcRR].
  		[AddcCqR]					-> [^self concretizeAddcCqR].
  		[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58].
  		[AddRsRs]					-> [^self concretizeSEEOpRsRs: 16r58].
  		[AndCqR]					-> [^self concretizeAndCqR].
  		[AndCwR]					-> [^self concretizeAndCwR].
+ 		[AndRR]					-> [^self concretizeOpRR: 16r23].
- 		[AndRR]						-> [^self concretizeOpRR: 16r23].
  		[TstCqR]					-> [^self concretizeTstCqR].
  		[CmpCqR]					-> [^self concretizeCmpCqR].
  		[CmpCwR]					-> [^self concretizeCmpCwR].
  		[CmpRR]					-> [^self concretizeReverseOpRR: 16r39].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[CmpRsRs]					-> [^self concretizeCmpRsRs].
  		[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
  		[DivRsRs]					-> [^self concretizeSEEOpRsRs: 16r5E].
  		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59].
  		[MulRsRs]					-> [^self concretizeSEEOpRsRs: 16r59].
+ 		[OrCqR]					-> [^self concretizeOrCqR].
- 		[OrCqR]						-> [^self concretizeOrCqR].
  		[OrCwR]					-> [^self concretizeOrCwR].
  		[OrRR]						-> [^self concretizeOpRR: 16r0B].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[SubCwR]					-> [^self concretizeSubCwR].
+ 		[SubRR]					-> [^self concretizeOpRR: 16r2B].
- 		[SubRR]						-> [^self concretizeOpRR: 16r2B].
  		[SubbRR]					-> [^self concretizeSubbRR].
  		[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C].
  		[SubRsRs]					-> [^self concretizeSEEOpRsRs: 16r5C].
  		[SqrtRd]						-> [^self concretizeSqrtRd].
  		[SqrtRs]						-> [^self concretizeSqrtRs].
  		[XorCwR]						-> [^self concretizeXorCwR].
  		[XorRR]							-> [^self concretizeOpRR: 16r33].
+ 		[XorRdRd]						-> [^self concretizeXorRdRd].
+ 		[XorRsRs]						-> [^self concretizeXorRsRs].
  		[NegateR]						-> [^self concretizeNegateR].
  		[NotR]							-> [^self concretizeNotR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
+ 		[ArithmeticShiftRightRR]		-> [^self concretizeArithmeticShiftRightRR].
- 		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeReverseOpRR: 16r89].
+ 		[MoveRdRd]		-> [^self concretizeMoveRdRd].
- 		[MoveRdRd]			-> [^self concretizeMoveRdRd].
  		[MoveRsRs]			-> [^self concretizeMoveRsRs].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[MoveAbR]			-> [^self concretizeMoveAbR].
  		[MoveRAb]			-> [^self concretizeMoveRAb].
+ 		[MoveMbrR]		-> [^self concretizeMoveMbrR].
+ 		[MoveRMbr]		-> [^self concretizeMoveRMbr].
+ 		[MoveRM8r]		-> [^self concretizeMoveRMbr].
+ 		[MoveM8rR]		-> [^self concretizeMoveM8rR].
- 		[MoveMbrR]			-> [^self concretizeMoveMbrR].
- 		[MoveRMbr]			-> [^self concretizeMoveRMbr].
- 		[MoveRM8r]			-> [^self concretizeMoveRMbr].
- 		[MoveM8rR]			-> [^self concretizeMoveM8rR].
  		[MoveM16rR]		-> [^self concretizeMoveM16rR].
  		[MoveRM16r]		-> [^self concretizeMoveRM16r].
  		[MoveM32rR]		-> [^self concretizeMoveMwrR].
  		[MoveRM32r]		-> [^self concretizeMoveRMwr].
  		[MoveM32rRs]		-> [^self concretizeMoveM32rRs].
  		[MoveM64rRd]		-> [^self concretizeMoveM64rRd].
  		[MoveMwrR]		-> [^self concretizeMoveMwrR].
  		[MoveXbrRR]		-> [^self concretizeMoveXbrRR].
  		[MoveRXbrR]		-> [^self concretizeMoveRXbrR].
  		[MoveXwrRR]		-> [^self concretizeMoveXwrRR].
  		[MoveRXwrR]		-> [^self concretizeMoveRXwrR].
  		[MoveRMwr]		-> [^self concretizeMoveRMwr].
  		[MoveRdM64r]		-> [^self concretizeMoveRdM64r].
- 		[MoveRsM32r]		-> [^self concretizeMoveRsM32r].
  		[PopR]				-> [^self concretizePopR].
  		[PushR]				-> [^self concretizePushR].
  		[PushCq]			-> [^self concretizePushCq].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
  		"Conversion"
+ 		[ConvertRRd]		-> [^self concretizeConvertRRd] }!
- 		[ConvertRRd]		-> [^self concretizeConvertRRd].
- 		[ConvertRdR]		-> [^self concretizeConvertRdR].
- 
- 		[ConvertRsRd]		-> [^self concretizeConvertRsRd].
- 		[ConvertRdRs]		-> [^self concretizeConvertRdRs].
- 		[ConvertRsR]		-> [^self concretizeConvertRsR].
- 		[ConvertRRs]		-> [^self concretizeConvertRRs].
- 
- 		[SignExtend8RR]	-> [^ self concretizeSignExtend8RR].
- 		[SignExtend16RR]	-> [^ self concretizeSignExtend16RR].
- 		[ZeroExtend8RR]	-> [^ self concretizeZeroExtend8RR].
- 		[ZeroExtend16RR]	-> [^ self concretizeZeroExtend16RR].
- 	}  otherwise: [^ self dispatchConcretize2].!

Item was removed:
- ----- Method: CogIA32Compiler>>dispatchConcretize2 (in category 'generate machine code') -----
- dispatchConcretize2
- 	"Attempt to generate concrete machine code for the instruction at address.
- 	 This is the inner dispatch of concretizeAt: actualAddress which exists only
- 	 to get around the branch size limits in the SqueakV3 (blue book derived)
- 	 bytecode set."
- 	<returnTypeC: #void>
- 	opcode caseOf: {
- 		[XorRsRs]				-> [^self concretizeXorRsRs].
- 		[XorRdRd]				-> [^self concretizeXorRdRd].
- 		[REP]					-> [^self concretizeREP].
- 		[CLD]					-> [^self concretizeCLD].
- 		[MOVSB]				-> [^self concretizeMOVSB].
- 		[MOVSD]				-> [^self concretizeMOVSD].
-  }.!

Item was added:
+ ----- Method: CogIA32Compiler>>dispatchConcretizeProcessorSpecific (in category 'generate machine code') -----
+ dispatchConcretizeProcessorSpecific
+ 	"Attempt to generate concrete machine code for the instruction at address.
+ 	 This is part of the inner dispatch of concretizeAt: actualAddress which exists only
+ 	 to get around the number of literals limits in the SqueakV3 (blue book derived)
+ 	 bytecode set."
+ 	<returnTypeC: #void>
+ 	opcode caseOf: {
+ 		"Specific Control/Data Movement"
+ 		[CDQ]					-> [^self concretizeCDQ].
+ 		[IDIVR]					-> [^self concretizeIDIVR].
+ 		[IMULRR]				-> [^self concretizeMulRR].
+ 		[CPUID]					-> [^self concretizeCPUID].
+ 		[CMPXCHGAwR]			-> [^self concretizeCMPXCHGAwR].
+ 		[CMPXCHGMwrR]		-> [^self concretizeCMPXCHGMwrR].
+ 		[LFENCE]				-> [^self concretizeFENCE: 5].
+ 		[MFENCE]				-> [^self concretizeFENCE: 6].
+ 		[SFENCE]				-> [^self concretizeFENCE: 7].
+ 		[LOCK]					-> [^self concretizeLOCK].
+ 		[XCHGAwR]				-> [^self concretizeXCHGAwR].
+ 		[XCHGMwrR]			-> [^self concretizeXCHGMwrR].
+ 		[XCHGRR]				-> [^self concretizeXCHGRR].
+ 		[FSTPS]					-> [^self concretizeFSTPS].
+ 		[FSTPD]				-> [^self concretizeFSTPD].
+ 		[REP]					-> [^self concretizeREP].
+ 		[CLD]					-> [^self concretizeCLD].
+ 		[MOVSB]				-> [^self concretizeMOVSB].
+ 		[MOVSD]				-> [^self concretizeMOVSD].
+ 	}!

Item was changed:
  ----- Method: CogSimStackNativeEntry class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
  instVarNamesAndTypesForTranslationDo: aBinaryBlock
  	"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogSimStackEntry struct."
  	"self printTypedefOn: Transcript"
  	self filteredInstVarNames do:
  		[:ivn|
  		aBinaryBlock
  			value: (ivn = 'register' ifTrue: ['registerr'] ifFalse: [ivn]) "avoid reservedWord conflict"
  			value: (ivn caseOf: {
+ 						['constantInt64']			-> [#sqLong].
- 						['constaintInt64']			-> [#sqLong].
  						['constantFloat32']			-> [#float].
  						['constantFloat64']			-> [#double].
  						['type']			-> [#char].
  						['spilled']		-> [#char].}
  					otherwise:
  						[#sqInt])]!

Item was changed:
  ----- Method: VMProfileMacSupportPlugin>>primitiveExecutableModulesAndOffsets (in category 'primitives') -----
  primitiveExecutableModulesAndOffsets
  	"Answer an Array of quads for executable modules (the VM executable
  	 and loaded libraries).  Each quad is the module's name, its vm address
  	 relocation in memory, the (unrelocated) start address, and the size."
+ 	| present nimages resultObj name valueObj nameObjData slide start size h h64 s |
- 	| present nimages resultObj name valueObj nameObjData slide start size h s |
  	<export: true>
  	<var: #name type: 'const char *'>
  	<var: #nameObjData type: #'char *'>
  	<var: #h type: 'const struct mach_header *'>
+ 	<var: #h64 type: 'const struct mach_header_64 *'>
  	<var: #s type: 'const struct section *'>
  	<var: #start type: 'unsigned long'>
  	<var: #size type: 'unsigned long'>
+ 	self cppIf: #'MAC_OS_X_VERSION_MIN_REQUIRED' <= #'MAC_OS_X_VERSION_10_4'
+ 		ifTrue: "_dyld_present was deprecated in 10.5"
+ 			[present := self cCode: '_dyld_present()' inSmalltalk: [false].
+ 			 present ifFalse:
+ 				[^interpreterProxy primitiveFail]].
- 	present := self cCode: '_dyld_present()' inSmalltalk: [false].
- 	present ifFalse:
- 		[^interpreterProxy primitiveFail].
  	nimages := self cCode: '_dyld_image_count()' inSmalltalk: [0].
  	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: nimages * 4.
  	resultObj = 0 ifTrue:
  		[^interpreterProxy primitiveFail].
  
  	interpreterProxy pushRemappableOop: resultObj.
  	0 to: nimages - 1 do:
  		[:i|
  		start := size := -1. "impossible start & size"
  		name := self cCode: '_dyld_get_image_name(i)' inSmalltalk: [0].
  		slide   := self cCode: '_dyld_get_image_vmaddr_slide(i)' inSmalltalk: [0].
+ 		self cppIf: #'__x86_64__'
+ 			ifTrue:
+ 				[h64 := self cCode: '_dyld_get_image_header(i)' inSmalltalk: [0].
+ 				 h64 ifNotNil:
+ 					[s := self cCode: 'getsectbynamefromheader_64(h64,SEG_TEXT,SECT_TEXT)' inSmalltalk: [0].
+ 					 s ~= nil ifTrue:
+ 						[start := self cCode: 's->addr' inSmalltalk: [0].
+ 						 size := self cCode: 's->size' inSmalltalk: [0]]]]
+ 			ifFalse:
+ 				[h := self cCode: '_dyld_get_image_header(i)' inSmalltalk: [0].
+ 				 h ifNotNil:
+ 					[s := self cCode: 'getsectbynamefromheader(h,SEG_TEXT,SECT_TEXT)' inSmalltalk: [0].
+ 					 s ~= nil ifTrue:
+ 						[start := self cCode: 's->addr' inSmalltalk: [0].
+ 						 size := self cCode: 's->size' inSmalltalk: [0]]]].
- 		h        := self cCode: '_dyld_get_image_header(i)' inSmalltalk: [0].
- 		h ~= nil ifTrue:
- 			[s := self cCode: 'getsectbynamefromheader(h,SEG_TEXT,SECT_TEXT)' inSmalltalk: [0].
- 			 s ~= nil ifTrue:
- 				[start := self cCode: 's->addr' inSmalltalk: [0].
- 				 size := self cCode: 's->size' inSmalltalk: [0]]].
  
  		valueObj := interpreterProxy
  						instantiateClass: interpreterProxy classString
  						indexableSize: (self strlen: name).
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
  		nameObjData := interpreterProxy arrayValueOf: valueObj.
  		self mem: nameObjData cp: name y: (self strlen: name).
  
  		valueObj := interpreterProxy signed32BitIntegerFor: slide.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 + 1 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
  
  		valueObj := interpreterProxy positiveMachineIntegerFor: start.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 + 2 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
  
  		valueObj := interpreterProxy positiveMachineIntegerFor: size.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 + 3 ofObject: interpreterProxy topRemappableOop withValue: valueObj].
  
  	resultObj := interpreterProxy popRemappableOop.
  	^interpreterProxy pop: 1 thenPush: resultObj!



More information about the Vm-dev mailing list