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

commits at source.squeak.org commits at source.squeak.org
Fri Nov 1 22:46:54 UTC 2013


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

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

Name: VMMaker.oscog-eem.491
Author: eem
Time: 1 November 2013, 1:43:38.082 pm
UUID: e480c63b-0653-4b07-97bb-82eff9db8854
Ancestors: VMMaker.oscog-eem.490

Fix roomToPushNArgs:; the Cog VMs can be more lenient because
of the use of a stack instead of contexts.  Simplify
primitiveDoNamedPrimitiveWithArgs.

Add missing NewObjectMemory>>badContextSize: so that the
VM doesn't use SmallContextSize.

Integrate VMMaker-dtl.328.

Integrate Nice's improved SmallInteger generated primitives that
support int x float comparison.

Fix compactCompiledCode: for simulation.

Slang:
Do not generate dead code by default.  Fix the trailing ; issue for
some sends.

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

Item was changed:
  ----- Method: BitBltSimulation>>primitiveDisplayString (in category 'primitives') -----
  primitiveDisplayString
  
  	| kernDelta xTable glyphMap stopIndex startIndex sourceString bbObj maxGlyph ascii glyphIndex sourcePtr left quickBlt |
  	<export: true>
  	<var: #sourcePtr type: 'char *'>
  	interpreterProxy methodArgumentCount = 6 
  		ifFalse:[^interpreterProxy primitiveFail].
  	kernDelta := interpreterProxy stackIntegerValue: 0.
  	xTable := interpreterProxy stackObjectValue: 1.
  	glyphMap := interpreterProxy stackObjectValue: 2.
  	((interpreterProxy fetchClassOf: xTable) = interpreterProxy classArray and:[
  		(interpreterProxy fetchClassOf: glyphMap) = interpreterProxy classArray])
  			ifFalse:[^interpreterProxy primitiveFail].
  	(interpreterProxy slotSizeOf: glyphMap) = 256 ifFalse:[^interpreterProxy primitiveFail].
  	interpreterProxy failed ifTrue:[^nil].
  	maxGlyph := (interpreterProxy slotSizeOf: xTable) - 2.
  
  	stopIndex := interpreterProxy stackIntegerValue: 3.
  	startIndex := interpreterProxy stackIntegerValue: 4.
  	sourceString := interpreterProxy stackObjectValue: 5.
  	(interpreterProxy isBytes: sourceString) ifFalse:[^interpreterProxy primitiveFail].
  	(startIndex > 0 and:[stopIndex > 0 and:[
  		stopIndex <= (interpreterProxy byteSizeOf: sourceString)]])
  			ifFalse:[^interpreterProxy primitiveFail].
  
  	bbObj := interpreterProxy stackObjectValue: 6.
  	(self loadBitBltFrom: bbObj) ifFalse:[^interpreterProxy primitiveFail].
  	(combinationRule = 30 or:[combinationRule = 31]) "needs extra source alpha"
  		ifTrue:[^interpreterProxy primitiveFail].
  	"See if we can go directly into copyLoopPixMap (usually we can)"
  	quickBlt := destBits ~= 0 "no OS surfaces please"
  				and:[sourceBits ~= 0 "and again"
  				and:[noSource = false "needs a source"
  				and:[sourceForm ~= destForm "no blits onto self"
  				and:[(cmFlags ~= 0 
  						or:[sourceMSB ~= destMSB 
  						or:[sourceDepth ~= destDepth]]) "no point using slower version"
  				]]]].
  	left := destX.
  	sourcePtr := interpreterProxy firstIndexableField: sourceString.
  	startIndex to: stopIndex do:[:charIndex|
  		ascii := interpreterProxy byteAtPointer: sourcePtr + charIndex - 1.
  		glyphIndex := interpreterProxy fetchInteger: ascii ofObject: glyphMap.
  		(glyphIndex < 0 or:[glyphIndex > maxGlyph]) 
  			ifTrue:[^interpreterProxy primitiveFail].
  		sourceX := interpreterProxy fetchInteger: glyphIndex ofObject: xTable.
  		width := (interpreterProxy fetchInteger: glyphIndex+1 ofObject: xTable) - sourceX.
  		interpreterProxy failed ifTrue:[^nil].
  		self clipRange.	"Must clip here"
  		(bbW > 0 and:[bbH > 0]) ifTrue: [
  			quickBlt ifTrue:[
  				self destMaskAndPointerInit.
  				self copyLoopPixMap.
  				"both, hDir and vDir are known to be > 0"
  				affectedL := dx.
  				affectedR := dx + bbW.
  				affectedT := dy.
  				affectedB := dy + bbH.
  			] ifFalse:[self copyBits]].
  		interpreterProxy failed ifTrue:[^nil].
  		destX := destX + width + kernDelta.
  	 ].
  	affectedL := left.
  	self showDisplayBits.
+ 	"store destX back"	
+ 	interpreterProxy storeInteger: BBDestXIndex ofObject: bbObj withValue: destX.
  	interpreterProxy pop: 6. "pop args, return rcvr"!

Item was changed:
  ----- Method: CCodeGenerator>>vmClass: (in category 'accessing') -----
  vmClass: aClass
+ 	"Set the main translation class if any.  This is nil other than for the core VM.
+ 	 It may be an interpreter or a cogit"
+ 	vmClass := aClass.
+ 	vmClass ifNotNil:
+ 		[generateDeadCode := vmClass shouldGenerateDeadCode]!
- 	"Set the interpreter class if any.  This is nil other than for the core VM."
- 	vmClass := aClass!

Item was changed:
  ----- Method: CoInterpreter>>roomToPushNArgs: (in category 'primitive support') -----
  roomToPushNArgs: n
+ 	"Answer if there is room to push n arguments onto the current stack.  We assume
+ 	 this is called by primitives that check there is enough room in any new context, and
+ 	 won't actually push the arguments in the current context if the primitive fails.  With
+ 	 this assumption it is safe to answer based on the maximum argument count, /not/
+ 	 the ammount of space in the current frame were it converted to a context.."
+ 	false
+ 		ifTrue: "old code that checked size of context..."
+ 			[| methodHeader cntxSize |
+ 			(self isMachineCodeFrame: framePointer)
+ 				ifTrue: [methodHeader := (self mframeHomeMethod: framePointer) methodHeader]
+ 				ifFalse: [methodHeader := self headerOf: (self iframeMethod: framePointer)].
+ 			cntxSize := (methodHeader bitAnd: LargeContextBit) ~= 0
+ 							ifTrue: [LargeContextSlots - CtxtTempFrameStart]
+ 							ifFalse: [SmallContextSlots - CtxtTempFrameStart].
+ 			^self stackPointerIndex + n <= cntxSize]
+ 		ifFalse: "simpler code that simply insists args are <= max arg count"
+ 			[^n <= (LargeContextSlots - CtxtTempFrameStart)]!
- 	"Answer if there is room to push n arguments onto the current stack.
- 	 There may be room in this stackPage but there may not be room if
- 	 the frame were converted into a context."
- 	| methodHeader cntxSize |
- 	(self isMachineCodeFrame: framePointer)
- 		ifTrue: [methodHeader := (self mframeHomeMethod: framePointer) methodHeader]
- 		ifFalse: [methodHeader := self headerOf: (self iframeMethod: framePointer)].
- 	cntxSize := (methodHeader bitAnd: LargeContextBit) ~= 0
- 					ifTrue: [LargeContextSlots - ReceiverIndex]
- 					ifFalse: [SmallContextSlots - ReceiverIndex].
- 	^self stackPointerIndex + n <= cntxSize!

Item was changed:
  ----- Method: CogMethodZone>>compactCompiledCode: (in category 'compaction') -----
  compactCompiledCode: objectHeaderValue
  	| source dest bytes |
  	<var: #source type: #'CogMethod *'>
  	<var: #dest type: #'CogMethod *'>
  	source := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
  	openPICList := nil.
  	methodCount := 0.
  	self cppIf: NewspeakVM ifTrue: [unpairedMethodList := nil].
  	[source < self limitZony
  	 and: [source cmType ~= CMFree]] whileTrue:
  		[self assert: (cogit cogMethodDoesntLookKosher: source) = 0.
  		 source objectHeader: objectHeaderValue.
  		 source cmUsageCount > 0 ifTrue:
  			[source cmUsageCount: source cmUsageCount // 2].
  		 self cppIf: NewspeakVM ifTrue:
  				[(source cmType = CMMethod
  				  and: [(coInterpreter rawHeaderOf: source methodObject) asInteger ~= source asInteger]) ifTrue:
  					[source nextMethod: unpairedMethodList.
  					 unpairedMethodList := source]].
  		 source cmType = CMOpenPIC ifTrue:
  			[source nextOpenPIC: openPICList asUnsignedInteger.
  			 openPICList := source].
  		 methodCount := methodCount + 1.
  		 source := self methodAfter: source].
  	source >= self limitZony ifTrue:
  		[^self halt: 'no free methods; cannot compact.'].
  	dest := source.
  	[source < self limitZony] whileTrue:
  		[self assert: (cogit maybeFreeCogMethodDoesntLookKosher: source) = 0.
  		 bytes := source blockSize.
  		 source cmType ~= CMFree ifTrue:
  			[methodCount := methodCount + 1.
+ 			 objectMemory mem: dest mo: source ve: bytes.
- 			 self mem: dest mo: source ve: bytes.
  			 dest objectHeader: objectHeaderValue.
  			 dest cmType = CMMethod
  				ifTrue:
  					["For non-Newspeak there should be a one-to-one mapping between bytecoded and
  					  cog methods.  For Newspeak not necessarily, but only for anonymous accessors."
  					"Only update the original method's header if it is referring to this CogMethod."
  					 (coInterpreter rawHeaderOf: dest methodObject) asInteger = source asInteger
  						ifTrue: [coInterpreter rawHeaderOf: dest methodObject put: dest asInteger]
  						ifFalse:
  							[self assert: (cogit noAssertMethodClassAssociationOf: dest methodObject) = objectMemory nilObject.
  							 self cppIf: NewspeakVM
  								ifTrue: [dest nextMethod: unpairedMethodList.
  										unpairedMethodList := dest]]]
  				ifFalse:
  					[dest cmType = CMOpenPIC ifTrue:
  						[dest nextOpenPIC: openPICList asUnsignedInteger.
  						 openPICList := dest]].
  			 dest cmUsageCount > 0 ifTrue:
  				[dest cmUsageCount: dest cmUsageCount // 2].
  			 dest := coInterpreter
  								cCoerceSimple: dest asUnsignedInteger + bytes
  								to: #'CogMethod *'].
  		 source := coInterpreter
  							cCoerceSimple: source asUnsignedInteger + bytes
  							to: #'CogMethod *'].
  	mzFreeStart := dest asUnsignedInteger.
  	methodBytesFreedSinceLastCompaction := 0!

Item was added:
+ ----- Method: NewObjectMemory>>badContextSize: (in category 'contexts') -----
+ badContextSize: oop
+ 	| numSlots |
+ 	numSlots := self numSlotsOf: oop.
+ 	^numSlots ~= SmallContextSlots and: [numSlots ~= LargeContextSlots]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveEqual (in category 'primitive generators') -----
  genPrimitiveEqual
+ 	^self genSmallIntegerComparison: JumpZero orDoubleComparison: #JumpFPEqual: asSymbol!
- 	^self genSmallIntegerComparison: JumpZero!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveGreaterOrEqual (in category 'primitive generators') -----
  genPrimitiveGreaterOrEqual
+ 	^self genSmallIntegerComparison: JumpGreaterOrEqual orDoubleComparison: #JumpFPGreaterOrEqual: asSymbol!
- 	^self genSmallIntegerComparison: JumpGreaterOrEqual!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveGreaterThan (in category 'primitive generators') -----
  genPrimitiveGreaterThan
+ 	^self genSmallIntegerComparison: JumpGreater orDoubleComparison: #JumpFPGreater: asSymbol!
- 	^self genSmallIntegerComparison: JumpGreater!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveLessOrEqual (in category 'primitive generators') -----
  genPrimitiveLessOrEqual
+ 	^self genSmallIntegerComparison: JumpLessOrEqual orDoubleComparison: #JumpFPLessOrEqual: asSymbol!
- 	^self genSmallIntegerComparison: JumpLessOrEqual!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveLessThan (in category 'primitive generators') -----
  genPrimitiveLessThan
+ 	^self genSmallIntegerComparison: JumpLess orDoubleComparison: #JumpFPLess: asSymbol!
- 	^self genSmallIntegerComparison: JumpLess!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveNotEqual (in category 'primitive generators') -----
  genPrimitiveNotEqual
+ 	^self genSmallIntegerComparison: JumpNonZero orDoubleComparison: #JumpFPNotEqual: asSymbol!
- 	^self genSmallIntegerComparison: JumpNonZero!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genSmallIntegerComparison:orDoubleComparison: (in category 'primitive generators') -----
+ genSmallIntegerComparison: jumpOpcode orDoubleComparison: jumpFPOpcodeGenerator
+ 	"Stack looks like
+ 		receiver (also in ResultReceiverReg)
+ 		arg
+ 		return address"
+ 	| jumpDouble jumpFail jumpTrue jumpCond |
+ 	<var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction *(*jumpFPOpcodeGenerator)(void *)'>
+ 	<var: #jumpDouble type: #'AbstractInstruction *'>
+ 	<var: #jumpFail type: #'AbstractInstruction *'>
+ 	<var: #jumpTrue type: #'AbstractInstruction *'>
+ 	<var: #jumpCond type: #'AbstractInstruction *'>	
+ 	self MoveMw: BytesPerWord r: SPReg R: TempReg.
+ 	self MoveR: TempReg R: ClassReg.
+ 	jumpDouble := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
+ 	self CmpR: ClassReg R: ReceiverResultReg. "N.B. FLAGS := RRReg - ClassReg"
+ 	jumpTrue := self gen: jumpOpcode.
+ 	self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
+ 		objRef: objectMemory falseObject.
+ 	self flag: 'currently caller pushes result'.
+ 	self RetN: BytesPerWord * 2.
+ 	jumpTrue jmpTarget: (self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
+ 						objRef: objectMemory trueObject).
+ 	self RetN: BytesPerWord * 2.
+ 	
+ 	"Argument may be a Float : let us check or fail"
+ 	jumpDouble jmpTarget: self Label.
+ 	objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: SendNumArgsReg.
+ 	self CmpCq: objectMemory classFloatCompactIndex R: SendNumArgsReg.
+ 	jumpFail := self JumpNonZero: 0.
+ 	
+ 	"It was a Float, so convert the receiver to double and perform the operation"
+ 	self MoveR: ReceiverResultReg R: TempReg.
+ 	objectRepresentation genConvertSmallIntegerToIntegerInScratchReg: TempReg.
+ 	self ConvertR: TempReg Rd: DPFPReg0.
+ 	objectRepresentation genGetDoubleValueOf: ClassReg into: DPFPReg1.
+ 	self CmpRd: DPFPReg1 Rd: DPFPReg0.
+ 	jumpCond := self perform: jumpFPOpcodeGenerator with: 0. "FP jumps are a little weird"
+ 	self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
+ 		objRef: objectMemory falseObject.
+ 	self flag: 'currently caller pushes result'.
+ 	self RetN: BytesPerWord * 2.
+ 	jumpCond jmpTarget: (self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
+ 							objRef: objectMemory trueObject).
+ 	self RetN: BytesPerWord * 2.
+ 
+ 	jumpFail jmpTarget: self Label.
+ 	^0!

Item was changed:
  ----- Method: StackInterpreter class>>initializeContextIndices (in category 'initialization') -----
  initializeContextIndices
  	"Class MethodContext"
  	SenderIndex := 0.
  	InstructionPointerIndex := 1.
  	StackPointerIndex := 2.
  	MethodIndex := 3.
  	ClosureIndex := 4. "N.B. Called receiverMap in old images, closureOrNil in newer images."
  	ReceiverIndex := 5.
  	CtxtTempFrameStart := 6.
  
  	SmallContextSlots := CtxtTempFrameStart + 16.  "16 indexable fields"
  	"Large contexts have 56 indexable fields.  Max with single header word of ObjectMemory [but not SpurMemoryManager ;-)]."
  	LargeContextSlots := CtxtTempFrameStart + 56.
  	
  	"Including the header size in these sizes is problematic for multiple memory managers,
+ 	 so we don't use them, except LargeContextSize for asserts.  Set small to #bogus for error checking."
+ 	SmallContextSize := #bogus.
+ 	LargeContextSize := LargeContextSlots * BytesPerOop + BaseHeaderSize.
- 	 so we don't use them, except LargeContextSize for asserts.  Set small to nil for error checking."
- 	SmallContextSize := nil.
- 	LargeContextSize := LargeContextSlots + 1 * BytesPerOop.
  
  	"Class BlockClosure"
  	ClosureOuterContextIndex := 0.
  	ClosureStartPCIndex := 1.
  	ClosureNumArgsIndex := 2.
  	ClosureFirstCopiedValueIndex := 3.
  	ClosureCopiedValuesIndex := 3!

Item was changed:
  ----- Method: StackInterpreter>>roomToPushNArgs: (in category 'primitive support') -----
  roomToPushNArgs: n
+ 	"Answer if there is room to push n arguments onto the current stack.  We assume
+ 	 this is called by primitives that check there is enough room in any new context, and
+ 	 won't actually push the arguments in the current context if the primitive fails.  With
+ 	 this assumption it is safe to answer based on the maximum argument count, /not/
+ 	 the ammount of space in the current frame were it converted to a context.."
+ 	false
+ 		ifTrue: "old code that checked size of context..."
+ 			[| cntxSize |
+ 			 self assert: method = (stackPages longAt: framePointer + FoxMethod).
+ 			 cntxSize := ((self headerOf: method) bitAnd: LargeContextBit) ~= 0
+ 							ifTrue: [LargeContextSlots - CtxtTempFrameStart]
+ 							ifFalse: [SmallContextSlots - CtxtTempFrameStart].
+ 			 ^self stackPointerIndex + n <= cntxSize]
+ 		ifFalse: "simpler code that simply insists args are <= max arg count"
+ 			[^n <= (LargeContextSlots - CtxtTempFrameStart)]!
- 	"Answer if there is room to push n arguments onto the current stack.
- 	 There may be room in this stackPage but there may not be room if
- 	 the frame were converted into a context."
- 	| cntxSize |
- 	self assert: method = (stackPages longAt: framePointer + FoxMethod).
- 	cntxSize := ((self headerOf: method) bitAnd: LargeContextBit) ~= 0
- 					ifTrue: [LargeContextSlots - ReceiverIndex]
- 					ifFalse: [SmallContextSlots - ReceiverIndex].
- 	^self stackPointerIndex + n <= cntxSize!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
  primitiveDoNamedPrimitiveWithArgs
  	"Simulate an primitiveExternalCall invocation (e.g. for the Debugger).  Do not cache anything.
  	 e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
  	| argumentArray arraySize methodArg methodHeader
  	  moduleName functionName moduleLength functionLength
  	  spec addr primRcvr ctxtRcvr isArray |
  	<var: #addr declareC: 'void (*addr)()'>
  	argumentArray := self stackTop.
+ 	methodArg := self stackValue: 2.
+ 	((objectMemory isArray: argumentArray)
+ 	 and: [objectMemory isOopCompiledMethod: methodArg]) ifFalse:
- 	(objectMemory isArray: argumentArray) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  	arraySize := objectMemory fetchWordLengthOf: argumentArray.
+ 	(self roomToPushNArgs: arraySize) ifFalse:
- 	self success: (self roomToPushNArgs: arraySize).
- 
- 	methodArg := self stackObjectValue: 2.
- 	self successful ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  
- 	(objectMemory isOopCompiledMethod: methodArg) ifFalse:
- 		[^self primitiveFailFor: -2]. "invalid args"
- 
  	methodHeader := self headerOf: methodArg.
- 
  	(self literalCountOfHeader: methodHeader) > 2 ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  	spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg.
  	isArray := self isInstanceOfClassArray: spec.
  	(isArray
  	and: [(objectMemory lengthOf: spec) = 4
  	and: [(self primitiveIndexOfMethod: methodArg header: methodHeader) = 117]]) ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  
  	(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
  
  	"The function has not been loaded yet. Fetch module and function name."
  	moduleName := objectMemory fetchPointer: 0 ofObject: spec.
  	moduleName = objectMemory nilObject
  		ifTrue: [moduleLength := 0]
  		ifFalse: [self success: (objectMemory isBytes: moduleName).
  				moduleLength := objectMemory lengthOf: moduleName.
  				self cCode: '' inSmalltalk:
  					[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
  						ifTrue: [moduleLength := 0  "Cause all of these to fail"]]].
  	functionName := objectMemory fetchPointer: 1 ofObject: spec.
  	self success: (objectMemory isBytes: functionName).
  	functionLength := objectMemory lengthOf: functionName.
  	self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
  
  	addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
  				OfLength: functionLength
  				FromModule: moduleName + BaseHeaderSize
  				OfLength: moduleLength.
  	addr = 0 ifTrue:
  		[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
  
  	"Cannot fail this primitive from now on.  Can only fail the external primitive."
  	objectMemory pushRemappableOop: (argumentArray := self popStack).
  	objectMemory pushRemappableOop: (primRcvr := self popStack).
  	objectMemory pushRemappableOop: self popStack. "the method"
  	objectMemory pushRemappableOop: self popStack. "the context receiver"
  	self push: primRcvr. "replace context receiver with actual receiver"
  	argumentCount := arraySize.
  	1 to: arraySize do:
  		[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
  	self callExternalPrimitive: addr.
  	ctxtRcvr  := objectMemory popRemappableOop.
  	methodArg := objectMemory popRemappableOop.
  	primRcvr := objectMemory popRemappableOop.
  	argumentArray := objectMemory popRemappableOop.
  	self successful ifFalse: "If primitive failed, then restore state for failure code"
  		[self pop: arraySize + 1.
  		 self push: ctxtRcvr.
  		 self push: methodArg.
  		 self push: primRcvr.
  		 self push: argumentArray.
  		 argumentCount := 3.
  		 "Hack.  A nil prim error code (primErrorCode = 1) is interpreted by the image
  		  as meaning this primitive is not implemented.  So to pass back nil as an error
  		  code we use -1 to indicate generic failure."
  		 primFailCode = 1 ifTrue:
  			[primFailCode := -1]]!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genSmallIntegerComparison:orDoubleComparison: (in category 'primitive generators') -----
+ genSmallIntegerComparison: jumpOpcode orDoubleComparison: jumpFPOpcodeGenerator
+ 	"Stack looks like
+ 		return address"
+ 	| jumpDouble jumpFail jumpTrue jumpCond |
+ 	<var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction *(*jumpFPOpcodeGenerator)(void *)'>
+ 	<var: #jumpDouble type: #'AbstractInstruction *'>
+ 	<var: #jumpFail type: #'AbstractInstruction *'>
+ 	<var: #jumpTrue type: #'AbstractInstruction *'>
+ 	<var: #jumpCond type: #'AbstractInstruction *'>	
+ 	self MoveR: Arg0Reg R: TempReg.
+ 	jumpDouble := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
+ 	self CmpR: Arg0Reg R: ReceiverResultReg. "N.B. FLAGS := RRReg - Arg0Reg"
+ 	jumpTrue := self gen: jumpOpcode.
+ 	self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
+ 		objRef: objectMemory falseObject.
+ 	self RetN: 0.
+ 	jumpTrue jmpTarget: (self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
+ 								objRef: objectMemory trueObject).
+ 	self RetN: 0.
+ 	
+ 	"Argument may be a Float : let us check or fail"
+ 	jumpDouble jmpTarget: self Label.
+ 	objectRepresentation genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
+ 	self CmpCq: objectMemory classFloatCompactIndex R: SendNumArgsReg.
+ 	jumpFail := self JumpNonZero: 0.
+ 	
+ 	"It was a Float, so convert the receiver to double and perform the operation"
+ 	objectRepresentation genConvertSmallIntegerToIntegerInScratchReg: ReceiverResultReg.
+ 	self ConvertR: ReceiverResultReg Rd: DPFPReg0.
+ 	objectRepresentation genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
+ 	self CmpRd: DPFPReg1 Rd: DPFPReg0.
+ 	jumpCond := self perform: jumpFPOpcodeGenerator with: 0. "FP jumps are a little weird"
+ 	self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
+ 		objRef: objectMemory falseObject.
+ 	self RetN: 0.
+ 	jumpCond jmpTarget: (self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
+ 							objRef: objectMemory trueObject).
+ 	self RetN: 0.
+ 	jumpFail jmpTarget: self Label.
+ 	^0!

Item was changed:
  ----- Method: TStmtListNode>>emitCCodeOn:prependToEnd:level:generator: (in category 'C code generation') -----
  emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level generator: aCodeGen
  	self emitCCommentOn: aStream level: level.
  	statements withIndexDo:
  		[:s :idx|
  		s emitCCommentOn: aStream level: level.
  		aStream peekLast ~~ Character tab ifTrue:
  			[aStream tab: level].
  		(aNodeOrNil notNil
  		 and: [idx = statements size])
  			ifTrue:
  				[s emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level generator: aCodeGen]
  			ifFalse:
  				[s emitCCodeOn: aStream level: level generator: aCodeGen].
+ 		(self stream: aStream endsWithAnyOf: '};') ifFalse:
- 		(self endsWithCloseBracket: aStream) ifFalse:
  			[s needsTrailingSemicolon ifTrue:
  				[aStream nextPut: $;]].
  		aStream cr].
  !

Item was added:
+ ----- Method: TStmtListNode>>stream:endsWithAnyOf: (in category 'testing') -----
+ stream: aStream endsWithAnyOf: characters
+ 	"Answer if the given stream ends in any of the characters, ignoring whitespace."
+ 	| pos ch popped |
+ 	pos := aStream position.
+ 	aStream class = WriteStream ifTrue: "i.e. nested in StreamContents"
+ 		[[pos > 0] whileTrue:
+ 			[ch := aStream originalContents at: pos.
+ 			 ch isSeparator ifFalse:
+ 				[^characters includes: ch].
+ 			 pos := pos - 1].
+ 		 ^false].
+ 
+ 	popped := OrderedCollection new.
+ 	[pos > 0] whileTrue:
+ 		[ch := popped addFirst: (aStream position: pos - 1; peek).
+ 		 ch isSeparator ifFalse:
+ 			[aStream nextPutAll: popped.
+ 			 ^characters includes: ch].
+ 		 pos := pos - 1].
+ 	aStream nextPutAll: popped.
+ 	^false!

Item was added:
+ ----- Method: VMClass class>>shouldGenerateDeadCode (in category 'translation') -----
+ shouldGenerateDeadCode
+ 	"Answer if the code generator should generate dead code, e.g. in false ifTrue: [dead] ifFalse: [live].
+ 	 This *may* be useful in debugging (see CCodeGenerator>>nilOrBooleanConstantReceiverOf: et al).
+ 	 But by default we answer false."
+ 
+ 	^false!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  	"VMMaker versionString"
  
+ 	^'4.7.0 (Cog)'!
- 	^'4.6.0 (Cog)'!



More information about the Vm-dev mailing list