[Vm-dev] VM Maker: VMMaker-dtl.357.mcz

[commits at source.squeak.org]

David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.357.mcz

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

Name: VMMaker-dtl.357
Author: dtl
Time: 30 December 2014, 6:32:30.531 pm
UUID: 96d483fb-0958-4bbe-b781-24d9787a20ad
Ancestors: VMMaker-dtl.356

VMMaker 4.13.10
Incorporate Plan9 compatibility changes by Alex Franchuk .
Reference Mantis 7821: Make generated interpreter code compatible with Plan9's POSIX C compiler

Summary of changes:
- Add inlineReturnTypes to CCodeGenerator. Use this in TSendNode to provide type casts where necessary to avoid compiler complaints.
- In TMethod, add a return null to void methods that do not contain an explicit return.
- In TAssigmentNode, generated an explicit type cast if needed.
- Variable declaration fixes for callExternalPrimitive:, ioUTCMicroseconds, primitiveLocalMicrosecondClock, primitiveUTCMicrosecondClock.

Miscellaneous
- Do not initialize inlineList to an empty Array or Dictionary because it is actually a Set that is initialized elsewhere in collectInlineList.
- Eliminate redundant calls to #initialize in VMMaker and subclasses.
- Clean up redundant initializations in ObjectMemory class>>initialize.

Note: RomePlugin (not in VMMaker package) now requires an update to ensure that #replaceCairoCalls produces selectors that are symbols, not strings.

=============== Diff against VMMaker-dtl.356 ===============

Item was changed:
  Object subclass: #CCodeGenerator
+ 	instanceVariableNames: 'translationDict inlineList constants variables variableDeclarations scopeStack methods macros preparedMethodList variablesSetCache headerFiles globalVariableUsage useSymbolicConstants generateDeadCode doNotRemoveMethodList asArgumentTranslationDict receiverDict vmClass currentMethod logger declareMethodsStatic permitMethodPruning pools abstractDeclarations uncheckedAbstractMethods selectorTranslations breakSrcInlineSelector breakDestInlineSelector inlineReturnTypes'
- 	instanceVariableNames: 'translationDict inlineList constants variables variableDeclarations scopeStack methods macros preparedMethodList variablesSetCache headerFiles globalVariableUsage useSymbolicConstants generateDeadCode doNotRemoveMethodList asArgumentTranslationDict receiverDict vmClass currentMethod logger declareMethodsStatic permitMethodPruning pools abstractDeclarations uncheckedAbstractMethods selectorTranslations breakSrcInlineSelector breakDestInlineSelector'
  	classVariableNames: 'UseRightShiftForDivide'
  	poolDictionaries: ''
  	category: 'VMMaker-Translation to C'!
  
  !CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
  This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.  
  See VMMaker for more useful info!

Item was changed:
  ----- Method: CCodeGenerator>>collectInlineList (in category 'inlining') -----
  collectInlineList
  	"Make a list of methods that should be inlined."
  	"Details: The method must not include any inline C, since the translator cannot
  	currently map variable names in inlined C code. The #inline: directive may be
  	used to override this for cases in which the C code or declarations are harmless.
  	Methods to be inlined must be small or called from only one place."
  
  	| methodsNotToInline callsOf inlineIt hasCCode nodeCount senderCount
+ sel returnTypesOf |
- sel |
  	methodsNotToInline := Set new: methods size.
  
  	"build dictionary to record the number of calls to each method"
  	callsOf := Dictionary new: methods size * 2.
+ 	returnTypesOf := Dictionary new: methods size.
  	methods keys do: [ :s | callsOf at: s put: 0 ].
+ 	methods do: [ :m | returnTypesOf at: m selector put: m returnType ].
  
  	"For each method, scan its parse tree once to:
  		1. determine if the method contains C code or declarations
  		2. determine how many nodes it has
  		3. increment the sender counts of the methods it calls
  		4. determine if it includes any C declarations or code"
  	inlineList := Set new: methods size * 2.
+ 	inlineReturnTypes := Dictionary new: methods size.
  	methods do: [ :m |
  		inlineIt := #dontCare.
  		(translationDict includesKey: m selector) ifTrue: [
  			hasCCode := true.
  		] ifFalse: [
  			hasCCode := m declarations size > 0.
  			nodeCount := 0.
  			m parseTree nodesDo: [ :node |
  				node isSend ifTrue: [
  					sel := node selector.
  					(sel = #cCode: or: [sel = #cCode:inSmalltalk:])
  						ifTrue: [ hasCCode := true ].
  					senderCount := callsOf at: sel ifAbsent: [ nil ].
  					nil = senderCount ifFalse: [
  						callsOf at: sel put: senderCount + 1.
  					].
  				].
  				nodeCount := nodeCount + 1.
  			].
  			inlineIt := m extractInlineDirective.  "may be true, false, or
  #dontCare"
  		].
  		(inlineIt ~= true and: [hasCCode or: [inlineIt = false]]) ifTrue: [
  			"Don't inline if method has C code or if it contains a negative inline
  			directive. If it contains a positive inline directive, permit inlining even
  			if C code is present."
  			methodsNotToInline add: m selector.
  		] ifFalse: [
  			((nodeCount < 40) or: [inlineIt = true]) ifTrue: [
  				"inline if method has no C code and is either small or contains
  inline directive"
  				inlineList add: m selector.
+ 				inlineReturnTypes at: sel put: m returnType.
  			].
  		].
  	].
  
  	callsOf associationsDo: [ :assoc |
  		((assoc value = 1) and: [(methodsNotToInline includes: assoc key)
  not]) ifTrue: [
  			inlineList add: assoc key.
  		].
  	].!

Item was added:
+ ----- Method: CCodeGenerator>>declToType: (in category 'public') -----
+ declToType: decl
+ 	"Extracts the type from a C declaration string"
+ 
+ 	| strs r |
+ 	decl isNil ifFalse: [
+ 		(decl indexOf: $=) > 0 ifTrue:
+ 			[ strs := (decl copyFrom: 1 to: ((decl indexOf: $=) - 1)) ]
+ 		ifFalse: [ strs := decl ].
+ 		strs := (strs withoutTrailingBlanks) subStrings: ' '.
+ 		strs size == 1 ifTrue: [ ^ strs first ]
+ 			ifFalse:
+ 		[
+ 			| asterisks |
+ 			r := ''.
+ 			strs allButLastDo: [ :s | r := r,s,' ' ].
+ 			"Bit of a hack to get 'type *'"
+ 			asterisks := (strs last copyFrom: 1 to: (strs last lastIndexOf: $*)).
+ 			asterisks size > 0 ifTrue: [ r := r,' ',asterisks ].
+ 			r := r withoutTrailingBlanks.
+ 			(((r indexOf: $() > 0) or: ((r indexOf: $)) > 0)) ifTrue: [ ^nil ].
+ 			^r withoutTrailingBlanks
+ 		].
+ 	] ifTrue: [ ^nil ].!

Item was changed:
  ----- Method: CCodeGenerator>>initialize (in category 'public') -----
  initialize
  	translationDict := Dictionary new.
- 	inlineList := Array new.
  	constants := Dictionary new: 100.
  	variables := OrderedCollection new: 100.
  	variableDeclarations := Dictionary new: 100.
  	methods := Dictionary new: 500.
  	macros := Dictionary new.
  	self initializeCTranslationDictionary.
  	receiverDict := Dictionary new.
  	headerFiles := OrderedCollection new.
  	globalVariableUsage := Dictionary new.
  	useSymbolicConstants := true.
  	generateDeadCode := true.
  	scopeStack := OrderedCollection new.
  	logger := (ProvideAnswerNotification new tag: #logger; signal) ifNil: [Transcript].
  	pools := IdentitySet new.
  	abstractDeclarations := IdentitySet new.
  	uncheckedAbstractMethods := OrderedCollection new.
  	selectorTranslations := IdentityDictionary new.!

Item was added:
+ ----- Method: CCodeGenerator>>inlineReturnType: (in category 'inlining') -----
+ inlineReturnType: selector
+ 	"gets the return type of a given inline selector"
+ 
+ 	^inlineReturnTypes at: selector ifAbsent: nil!

Item was changed:
  ----- Method: CrossPlatformVMMaker>>createCodeGenerator (in category 'initialize') -----
  createCodeGenerator
  	"Set up a CCodeGenerator for this VMMaker - A cross platform tree leaves it up to the makefiles to decide whether to use the global struct or not."
+ 	^CCodeGeneratorGlobalStructure new
- 	^CCodeGeneratorGlobalStructure new initialize;
  		globalStructDefined: true;
  		structDefDefine: 'USE_GLOBAL_STRUCT';
  		logger: logger;
  		yourself!

Item was changed:
  ----- Method: Interpreter>>callExternalPrimitive: (in category 'plugin primitive support') -----
  callExternalPrimitive: functionID
  	"Call the external plugin function identified. In the VM this is an address, see 	InterpreterSimulator for it's version. "
  
+ 	<var: #functionID declareC: 'void (*functionID)(void)'>
- 	<var: #functionID declareC: 'void *functionID(void)'>
  	self dispatchFunctionPointer: functionID!

Item was changed:
  ----- Method: InterpreterPrimitives>>ioUTCMicroseconds (in category 'FIXME') -----
  ioUTCMicroseconds
  	"Answer the UTC microseconds since the Smalltalk epoch. The value is
  	derived from the Posix epoch (see primitiveUTCMicrosecondClock) with a
  	constant offset corresponding to elapsed microseconds between the two
  	epochs according to RFC 868."
  
  	"Added to Cross/vm/sqVirtualMachine but incompatible with existing timer
  	support in Cross. Implemented here to provide the function not present in
  	the support code. See also primitiveUTCMicrosecondClock."
  
  	| clock offset epochDelta uSecs |
  	<export: true>
  	<returnTypeC: 'usqLong'>
+ 	<var: #clock type: 'sqLong'>
- 	<var: #clock type: 'usqLong'>
  	<var: #offset type: 'int'>
  	<var: #epochDelta declareC: 'static usqLong epochDelta= 2177452800000000ULL'>
  
  	self flag: #FIXME. "remove this method when platform sources are reconciled"
  
  	(self cCode: 'ioUtcWithOffset(&clock, &offset)' inSmalltalk: [-1]) = -1
  		ifTrue: [^ self primitiveFail].
  	clock := clock + epochDelta.
  	uSecs := self positive64BitIntegerFor: clock.
  	^uSecs.
  !

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveLocalMicrosecondClock (in category 'system control primitives') -----
  primitiveLocalMicrosecondClock
  	"Answer the local microseconds since the Smalltalk epoch. The value is
  	derived from the Posix epoch (see primitiveUTCMicrosecondClock) with a
  	constant offset corresponding to elapsed microseconds between the two
  	epochs according to RFC 868, and with an offset duration corresponding to
  	the current offset of local time from UTC."
  	
  	| clock offset offsetMillis epochDelta uSecs |
  
  	<export: true>
+ 	<var: #clock type: 'sqLong'>
- 	<var: #clock type: 'usqLong'>
  	<var: #offset type: 'int'>
  	<var: #offsetMillis type: 'usqLong'>
  	<var: #epochDelta declareC: 'static usqLong epochDelta= 2177452800000000ULL'>
  	(self cCode: 'ioUtcWithOffset(&clock, &offset)' inSmalltalk: [-1]) = -1
  		ifTrue: [^ self primitiveFail].
  	clock := clock + epochDelta. "adjust for nominal Smalltalk epoch"
  	offsetMillis := offset.
  	offsetMillis := offsetMillis * 1000000.
  	clock := clock + offsetMillis. "adjust for local time offset"
  	uSecs := self positive64BitIntegerFor: clock.
  	self pop: 1 thenPush: uSecs.
  !

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveUTCMicrosecondClock (in category 'system control primitives') -----
  primitiveUTCMicrosecondClock
  	"Answer the UTC microseconds since the Smalltalk epoch. The value is
  	derived from the Posix epoch (see primitiveUTCMicrosecondClock) with a
  	constant offset corresponding to elapsed microseconds between the two
  	epochs according to RFC 868."
  	| clock offset epochDelta uSecs |
  
  	<export: true>
+ 	<var: #clock type: 'sqLong'>
- 	<var: #clock type: 'usqLong'>
  	<var: #offset type: 'int'>
  	<var: #epochDelta declareC: 'static usqLong epochDelta= 2177452800000000ULL'>
  	(self cCode: 'ioUtcWithOffset(&clock, &offset)' inSmalltalk: [-1]) = -1
  		ifTrue: [^ self primitiveFail].
  	clock := clock + epochDelta.
  	uSecs := self positive64BitIntegerFor: clock.
  	self pop: 1 thenPush: uSecs.
  !

Item was changed:
  ----- Method: MacOSPowerPCOS9VMMaker>>createCodeGenerator (in category 'initialize') -----
  createCodeGenerator
  "set up a CCodeGenerator for this VMMaker - Mac OS uses the global struct and local def of the structure"
+ 	^CCodeGeneratorGlobalStructure new
+ 		globalStructDefined: true!
- 	^CCodeGeneratorGlobalStructure new initialize; globalStructDefined: true!

Item was changed:
  ----- Method: ObjectMemory class>>initialize (in category 'initialization') -----
  initialize
  	"ObjectMemory initialize"
  
  	self initializeConstants.
  	self initializePrimitiveErrorCodes.
  	self initializeCompactClassIndices.
- 	self initializeObjectHeaderConstants.
- 	self initializeObjectWordConstants.
  	self initializePrimitiveErrorCodes.
  	self initializeSmallIntegers.
+ !
- 	self initializeSpecialObjectIndices!

Item was changed:
  ----- Method: RiscOSVMMaker>>createCodeGenerator (in category 'initialize') -----
  createCodeGenerator
  "set up a CCodeGenerator for this VMMaker - RiscOS uses the global struct and no local def of the structure because of the global register trickery"
+ 	^CCodeGeneratorGlobalStructure new
+ 		globalStructDefined: false!
- 	^CCodeGeneratorGlobalStructure new initialize; globalStructDefined: false!

Item was changed:
  ----- Method: TAssignmentNode>>emitCCodeOn:level:generator: (in category 'C code generation') -----
  emitCCodeOn: aStream level: level generator: aCodeGen
  	expression isSwitch ifTrue:
  		[^expression emitCCodeOn: aStream addToEndOfCases: self level: level generator: aCodeGen].
  	variable emitCCodeOn: aStream level: level generator: aCodeGen.
  	self isVariableUpdatingAssignment
  		ifTrue:
  			[aStream
  				space;
  				nextPutAll: expression selector;	"+ or -"
  				nextPut: $=;
  				space.
  			expression args first emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen]
  		ifFalse:
+ 			[| vartype |
+ 			 aStream space; nextPut: $=; space.
+ 			 "Add an appropriate cast if we need to do so"
+ 			 vartype := aCodeGen typeOfVariable: variable name.
+ 			 vartype := aCodeGen declToType: vartype.
+ 			 ((expression isMemberOf: TSendNode) and: [vartype ~= nil])
+ 				ifTrue:
+ 					[| fntype expselector |
+ 					 vartype := vartype asSymbol.
+ 					 expselector := expression selector.
+ 					 fntype := (aCodeGen methodNamed: expselector).
+ 					 fntype notNil ifTrue: [ fntype := fntype returnType ].
+ 					 "The expression may have been inlined"
+ 					 fntype isNil ifTrue: [ fntype := aCodeGen inlineReturnType: expselector ].
+ 					 (fntype notNil and: [ fntype ~= vartype ] and: [ vartype ~= #void ]) ifTrue:
+ 						[aStream nextPut: $(; nextPutAll: vartype asString; nextPut: $)].
+ 					].
- 			[aStream space; nextPut: $=; space.
  			 expression emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen]!

Item was added:
+ ----- Method: TMethod>>argTypes (in category 'accessing') -----
+ argTypes
+ 	"Get the types of the parameters of this method"
+ 
+ 	^args collect: [ :a | self declarationAt: a ]!

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 before function"
  	self emitCHeaderOn: aStream generator: aCodeGen.
  	parseTree emitCCodeOn: aStream level: 1 generator: aCodeGen.
+ 	"Ensure code is POSIX compliant"
+ 	(self returnType = #void or: [self endsWithReturn]) ifFalse: [aStream tab: 1; nextPutAll: 'return null;'; cr].
  	aStream nextPutAll: '}'; cr.!

Item was changed:
  ----- Method: TSendNode>>emitCCodeAsFunctionCallOn:level:generator: (in category 'C code generation') -----
  emitCCodeAsFunctionCallOn: aStream level: level generator: aCodeGen
  
  	"Translate this message send into a C function call"
  	"Special case for pluggable modules. Replace messages to interpreterProxy
  	 by interpreterProxy->message(..) if the message is not builtin"
+ 	| fn fnargtypes |
  	(aCodeGen isGeneratingPluginCode
  	 and: [receiver isVariable
  	 and: ['interpreterProxy' = receiver name
  	 and: [self isBuiltinOperator not]]]) ifTrue:
  		[aStream nextPutAll:'interpreterProxy->'].
  	"Translate this message send into a C function call."
  	aStream nextPutAll: (aCodeGen cFunctionNameFor: selector); nextPut: $(.
  	"Only include the receiver as the first argument in certain cases.
  	 The receiver is always included if it is an expression.
  	 If it is a variable:
  		 If the vmClass says it is an implicit variable, don't include it.
  		 If the variable is 'self' and the method being called is not in
  		 the method set (i.e. it is some external code), don't include it."
  	(self shouldIncludeReceiverAsFirstArgument: aCodeGen) ifTrue:
  		[receiver emitCCodeOn: aStream level: level generator: aCodeGen.
  		arguments isEmpty ifFalse:
  			[aStream nextPutAll: ', ']].
+ 	fn := aCodeGen methodNamed: self selector.
+ 	fn notNil ifTrue: [ fnargtypes := fn argTypes ].
+ 	fnargtypes notNil ifTrue: [ fnargtypes size = arguments size ifFalse: [ fnargtypes := nil ] ].
+ 	fnargtypes notNil ifTrue: [ fnargtypes := fnargtypes collect: [ :a | aCodeGen declToType: a ]].
+ 	arguments withIndexDo:
+ 		[ :arg :i | | argtype fnargtype |
+ 		i = 1 ifFalse: [aStream nextPut: $,; space].
+ 		argtype := nil.
+ 		fnargtype := nil.
+ 		(arg name notNil) ifTrue: [ argtype := aCodeGen declToType: (aCodeGen typeOfVariable: arg name) ].
+ 		fnargtypes notNil ifTrue: [ fnargtype := fnargtypes at: i ].
+ 		"Insert cast of function argument type if necessary"
+ 		(argtype notNil and: fnargtype notNil and: [ argtype ~= fnargtype ]) ifTrue: [ aStream nextPutAll: '(',fnargtype,')'  ]. 
+ 		arg emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen].
- 	arguments do:
- 		[ :arg| arg emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen]
- 		separatedBy: [aStream nextPut: $,; space].
  	aStream nextPut: $)!

Item was changed:
  ----- Method: TStmtListNode>>endsWithReturn (in category 'testing') -----
  endsWithReturn
  	"Answer true if the last statement of this lock is a return."
  
+ 	^ statements isEmpty not
+ 		and: [statements last isReturn
+ 				or: [statements last isReturningIf]]!
- 	^statements last isReturn or: [statements last isReturningIf]!

Item was changed:
  ----- Method: UnixVMMaker>>createCodeGenerator (in category 'initialisation') -----
  createCodeGenerator
  
  	^CCodeGeneratorGlobalStructure new
- 		initialize;
  		globalStructDefined: true!

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

Item was changed:
  ----- Method: VMMaker>>createCodeGenerator (in category 'initialize') -----
  createCodeGenerator
  "set up a CCodeGenerator for this VMMaker"
+ 	^CCodeGenerator new!
- 	^CCodeGenerator new initialize!