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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 15 23:11:56 UTC 2015


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

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

Name: VMMaker.oscog-eem.1455
Author: eem
Time: 15 September 2015, 4:09:42.434 pm
UUID: 79b98152-ce26-4bf5-a737-3d8b41450be8
Ancestors: VMMaker.oscog-EstebanLorenzano.1454

Simplify ffiCreateIntegralResultOop:ofAtomicType:in: gievn that my modification was completely wrong <blush>.

Make sure the actual SMalltalk selector is included in error messages and the comment at teh beginning of a generated C function.

Fix C compiler warnings by making sqAssert: answer its argument (as looked like the intent from the original version).

=============== Diff against VMMaker.oscog-EstebanLorenzano.1454 ===============

Item was changed:
  ----- Method: CCodeGenerator>>checkForGlobalUsage:in: (in category 'utilities') -----
  checkForGlobalUsage: vars in: aTMethod 
  	vars do:
  		[:var |
  		(variables includes: var) ifTrue: "find the set of method names using this global var"
  			[(globalVariableUsage at: var ifAbsentPut: [Set new])
  				add: aTMethod selector]].
  	aTMethod clearReferencesToGlobalStruct.
  	(aTMethod locals select: [:l| self reservedWords includes: l]) do:
  		[:l| | em |
+ 		em := aTMethod definingClass name, '>>', aTMethod smalltalkSelector, ' has variable that is a C reserved word: ', l.
- 		em := aTMethod definingClass name, '>>', aTMethod selector, ' has variable that is a C reserved word: ', l.
  		self error: em.
  		self logger cr; nextPutAll: em; cr; flush]!

Item was changed:
  ----- Method: SmartSyntaxInterpreterPlugin>>sqAssert: (in category 'debugging') -----
  sqAssert: aBool 
+ 	self debugCode:
+ 		[aBool ifFalse:
+ 			[self error: 'Assertion failed!!']].
+ 	^aBool!
- 	self
- 		debugCode: [aBool
- 				ifFalse: [self error: 'Assertion failed!!'].
- 			^ aBool]!

Item was added:
+ ----- Method: SmartSyntaxPluginTMethod>>smalltalkSelector (in category 'accessing') -----
+ smalltalkSelector
+ 	"Answer the selector of the original Smalltalk method, not any mangled one."
+ 	^fullSelector ifNil: [selector]!

Item was changed:
  ----- Method: TMethod>>emitCCodeOn:generator: (in category 'C code generation') -----
  emitCCodeOn: aStream generator: aCodeGen
  	"Emit C code for this method onto the given stream.
  	 All calls to inlined methods should already have been expanded."
  
  	aCodeGen currentMethod: self.
  	self emitCCommentOn: aStream.	"place method comment and method name before function."
+ 	aStream crtab; nextPutAll: '/* '; nextPutAll: self definingClass name; nextPutAll: '>>#'; nextPutAll: self smalltalkSelector; nextPutAll: ' */'.	
- 	aStream crtab; nextPutAll: '/* '; nextPutAll: self definingClass name; nextPutAll: '>>#'; nextPutAll: self selector; nextPutAll: ' */'.	
  	aStream cr. 
  	self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: false.
  	aStream cr; nextPut: ${.
  	self emitCLocalsOn: aStream generator: aCodeGen.
  	aCodeGen
  		pushScope: declarations
  		while: [parseTree emitCCodeOn: aStream level: 1 generator: aCodeGen].
  	aStream nextPut: $}; cr!

Item was added:
+ ----- Method: TMethod>>smalltalkSelector (in category 'accessing') -----
+ smalltalkSelector
+ 	"Answer the selector of the original Smalltalk method, not any mangled one."
+ 	^selector!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiCreateIntegralResultOop:ofAtomicType:in: (in category 'callout support') -----
  ffiCreateIntegralResultOop: retVal ofAtomicType: atomicType in: calloutState
  	<inline: true>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #retVal type: #usqLong>
  	"Callout support. Return the appropriate oop for the given atomic type"
  	| shift value mask byteSize |
  	self assert: atomicType < FFITypeSingleFloat.
  
  	atomicType = FFITypeBool ifTrue:
  		["Make sure bool honors the byte size requested"
  		 byteSize := calloutState ffiRetHeader bitAnd: FFIStructSizeMask.
  		 value := byteSize = (self sizeof: retVal)
  					ifTrue:[retVal]
  					ifFalse:[retVal bitAnd: 1 << (byteSize * 8) - 1].
  		 ^value = 0
  			ifTrue:[interpreterProxy falseObject]
  			ifFalse:[interpreterProxy trueObject]].
  	atomicType <= FFITypeSignedInt ifTrue:
  		["these are all generall integer returns"
  		atomicType <= FFITypeSignedShort ifTrue:
  			["byte/short. first extract partial word, then sign extend"
  			shift := (atomicType >> 1) * 8. "# of significant bits"
  			value := retVal bitAnd: (1 << shift - 1). 
  			(atomicType anyMask: 1) ifTrue:
  				["make the guy signed"
  				mask := 1 << (shift-1).
  				value := (value bitAnd: mask-1) - (value bitAnd: mask)].
  			^interpreterProxy integerObjectOf: value].
  		"32bit integer return"
  		^(atomicType anyMask: 1)
  			ifTrue:[interpreterProxy signed32BitIntegerFor: retVal] "signed return"
  			ifFalse:[interpreterProxy positive32BitIntegerFor: retVal]]. "unsigned return"
  
  	"longlong, char"
  	^(atomicType >> 1) = (FFITypeSignedLongLong >> 1) 
  		ifTrue:
  			[(atomicType anyMask: 1)
  				ifTrue:[interpreterProxy signed64BitIntegerFor: retVal] "signed return"
  				ifFalse:[interpreterProxy positive64BitIntegerFor: retVal]]
  		ifFalse:
+ 			[interpreterProxy characterObjectOf: (retVal bitAnd: Byte0Mask)]!
- 			[interpreterProxy characterObjectOf:
- 				(retVal bitAnd: (self cppIf: #SPURVM
- 									ifTrue: [Byte0Mask]
- 									ifFalse: [255]))]!



More information about the Vm-dev mailing list