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

commits at source.squeak.org commits at source.squeak.org
Sat Nov 5 01:34:37 UTC 2022


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

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

Name: VMMaker.oscog-eem.3263
Author: eem
Time: 4 November 2022, 6:34:15.825583 pm
UUID: c48ac37e-0ad2-430c-9c68-bd264949a3cc
Ancestors: VMMaker.oscog-eem.3262

Improve dead code elimination, in particular for empty cppIf: constructs (i.e. ensureExecutableCodeZone in non-ARMv8 contexts).

Fix a mistake in Cogit class>>defineAtCompileTime: which mistakenly assumed COGMTVM & Debug are defined at translation time.

Make sure SpurMemoryManager class>>initializeWithOptions: defines SPURVM.

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

Item was changed:
  ----- Method: CCodeGenerator>>generateInlineCppIfElse:asArgument:on:indent: (in category 'C translation') -----
  generateInlineCppIfElse: msgNode asArgument: asArgument on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  	| lastCondition allAlternativesWereDeterminable expr pos directive index keywords |
  	"Compile-time expansion for constants set in the options dictionary,
  	 e.g. to cut down on noise for MULTIPLEBYTECODESETS."
  
+ 	"First eliminate empty expansions, e.g. ensureExecutableCodeZone in non-ARMv8 Cogits"
+ 	(msgNode args allButFirst allSatisfy: #isNullCCode) ifTrue:
+ 		[^self].
+ 
+ 	"Then attempt to expand statically..."
- 	"First attempt to expand statically..."
  	allAlternativesWereDeterminable := true.
  	lastCondition := nil.
  	msgNode selector keywords "Deal with cppIf:ifTrue:, cppIf:ifTrue:ifFalse:, cppIf:ifTrue:cppIf:ifTrue:ifFalse:, etc"
  		with: msgNode args
  		do: [:keyword :node| | expansion |
  			self assert: (#(cppIf: ifFalse: ifTrue:) includes: keyword).
  			keyword = #cppIf:
  				ifTrue:
  					[(self nilOrBooleanConditionFor: node)
  						ifNil: [allAlternativesWereDeterminable := false]
  						ifNotNil: [:condition| lastCondition := condition]]
  				ifFalse:
  					[(allAlternativesWereDeterminable
  					 and: [lastCondition == (keyword = #ifTrue:)]) ifTrue:
  						[asArgument
  							ifTrue: "emitCCodeAsArgumentOn: doesn't indent, the code needs indenting if it takes multiple lines, so post-process."
  								[expansion := String streamContents: [:s| node emitCCodeAsArgumentOn: s level: level generator: self].
  								  aStream nextPutAll:
  									  ((expansion includes: Character cr)
  										ifTrue:
  											[(String streamContents:
  													[:s|
  													s position > 0 ifTrue: [s tab: level + 1].
  													node emitCCodeAsArgumentOn: s level: level generator: self])
  												copyReplaceAll: (String with: Character cr)
  												with: (String with: Character cr), (String new: level + 1 withAll: Character tab)]
  										ifFalse: [expansion])]
  							ifFalse:
  								[expansion := String streamContents: [:s| node emitCCodeOn: s level: level generator: self].
  								 "Remove tabs from first line to avoid indenting a second time"
  								 expansion ifNotEmpty:
  									[expansion := expansion allButFirst: (expansion findFirst: [:c| c ~~ Character tab]) - 1].
  								 aStream nextPutAll: expansion].
  						 ^self]]].
+ 	allAlternativesWereDeterminable ifTrue:
+ 		[^self].
- 	self deny: allAlternativesWereDeterminable.
  
  	"Expand for compile-time evaluation. Full #if ... #else..."
  
  	directive := 'if'.
  	index := 0.
  	expr := nil.
  	(keywords := msgNode selector keywords) "Deal with cppIf:ifTrue:, cppIf:ifFalse:, cppIf:ifTrue:ifFalse:, cppIf:ifTrue:cppIf:ifTrue:ifFalse:, etc"
  		with: msgNode args
  		do: [:keyword :node| | expansion |
  			self assert: (#(cppIf: ifFalse: ifTrue:) includes: keyword).
  			index := index + 1.
  			keyword = #cppIf:
  				ifTrue:
  					[lastCondition := node.
  					expansion := String streamContents: [:es| node emitCCodeAsArgumentOn: es level: 0 generator: self].
  					(keywords at: index + 1) = #ifFalse: ifTrue:
  						[expansion := node isLeaf ifTrue: ['!!', expansion] ifFalse: ['!!(', expansion, ')']].
  					[expansion last isSeparator] whileTrue:
  						[expansion := expansion allButLast].
  					aStream
  						ensureCr;
  						nextPut: $#; space: level * 2; nextPutAll: directive; space; nextPutAll: expansion; cr.
  					directive := 'elif'.
  					expr := (expr ifNil: [' // '] ifNotNil: [expr, ' || ']), expansion]
  				ifFalse:
  					[(keywords at: index - 1) = #cppIf: ifFalse: "this is an else..."
  						[aStream
  							ensureCr;
  							nextPut: $#; next: level * 2 put: Character space; nextPutAll: 'else'.
  						 aStream position - pos >= 128 ifTrue:
  							[aStream nextPutAll: expr].
  						 aStream cr].
  					pos := aStream position.
  					self with: lastCondition
  						ifAppropriateSetTo: keyword = #ifTrue:
  						do: [asArgument
  								ifTrue: "emitCCodeAsArgumentOn: doesn't indent, the code needs indenting in this case, so post-process."
  									[aStream nextPutAll:
  										((String streamContents:
  												[:s|
  												s next: level + 1 put: Character tab.
  												node emitCCodeAsArgumentOn: s level: level generator: self])
  											copyReplaceAll: (String with: Character cr)
  											with: (String with: Character cr), (String new: level + 1 withAll: Character tab))]
  								ifFalse:
  									[node emitCCodeOn: aStream level: level generator: self]]]].
  	aStream
  		ensureCr;
  		nextPut: $#; next: level * 2 put: Character space; nextPutAll: 'endif'.
  	aStream position - pos >= 128 ifTrue:
  		[aStream nextPutAll: expr].
  	aStream cr.
  	asArgument ifTrue:
  		[aStream next: level + 1 put: Character tab]!

Item was changed:
  ----- Method: CCodeGenerator>>nilOrBooleanConditionFor: (in category 'utilities') -----
  nilOrBooleanConditionFor: nodeOrNil
  	"If nodeOrNil is one of the conditional sends for which we do translation-time dead code elimination
  	 (i.e. cppIf:ifTrue: et al or ifTrue: et al) and the conditional does evaluate to a translation-time
  	 boolean constant, answer that constant, otherwise answer nil.  Used to prune dead code,
  	 either for code generaton or dead variable elimination."
  	generateDeadCode ifTrue: [^nil].
  	nodeOrNil ifNil:
  		[^nil].
+ 	nodeOrNil isConstant ifTrue:
+ 		[^self nilOrBooleanConstantReceiverOf: nodeOrNil].
  	nodeOrNil isSend ifFalse:
  		[^nil].
  	(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: nodeOrNil selector) ifTrue:
  		[^self nilOrBooleanConstantReceiverOf: nodeOrNil receiver].
  	(#(and: or:) includes: nodeOrNil selector) ifTrue:
  		[^self nilOrBooleanConstantReceiverOf: nodeOrNil].
  	(#(cppIf:ifTrue: cppIf:ifTrue:ifFalse:) includes: nodeOrNil selector) ifTrue:
  		[| maybeName value |
  		(vmClass notNil
  		 and: [nodeOrNil args first isConstant
  		 and: [(value := nodeOrNil args first value) isSymbol
  		 and: [(self defineAtCompileTime: value) not
  		 and: [(vmClass bindingOf: value) notNil]]]]) ifTrue:
  			[self logger
  					nextPutAll: 'Warning: cppIf: reference to ';
  					store: value;
  					nextPutAll: ' when variable of same name exists.'; cr].
  
  		maybeName := nodeOrNil args first isConstant ifTrue:
  							[nodeOrNil args first nameOrValue].
  		 ^(optionsDictionary notNil
  		   and: [nodeOrNil args first isConstant
  		   and: [(#(true false) includes: (optionsDictionary at: maybeName ifAbsent: [nil]))
  		   and: [(self defineAtCompileTime: maybeName) not]]]) ifTrue:
  			[optionsDictionary at: nodeOrNil args first name]].
  	^nil!

Item was changed:
  ----- Method: Cogit class>>defineAtCompileTime: (in category 'C translation') -----
  defineAtCompileTime: anObject
  	"Override to define at translation time those variables that need to
  	 be defined at compile time only in plugins, but not in the main VM,
  	 because the VM generated is specific to these varables."
  	anObject isSymbol ifFalse:
  		[^false].
+ 	(#(COGMTVM Debug) includes: anObject) ifTrue:
+ 		[^true].
+ 	(#(STACKVM COGVM SPURVM) includes: anObject) ifTrue:
- 	(#(STACKVM COGVM COGMTVM SPURVM) includes: anObject) ifTrue:
  		[^false].
  	^VMBasicConstants defineAtCompileTime: anObject!

Item was changed:
  ----- Method: Cogit>>ensureExecutableCodeZone (in category 'memory access') -----
  ensureExecutableCodeZone
  	"On some platforms run-time calls may be required to enable execution and disable
  	 write-protect of the code zone. This is sequenced by ensuring that the code zone is
  	 executable most of the time.  Note that any code space modification requires an
  	 icache flush (on processors with such an icache). Hence the least invasive time to
  	 ensure code is executable is post icache flush.  Making sure code is writable can be
  	 done either before any bulk edit (e.g. code zone reclamation) or as part of any fine-
  	 grained code modification (e.g. setting an anonymous method's selector)."
  	<inline: #always>
  	
  	self cppIf: #DUAL_MAPPED_CODE_ZONE
  		ifFalse:
  			[backEnd needsCodeZoneExecuteWriteSwitch ifTrue:
  				[self cCode: nil inSmalltalk: [| currentAPISelector |
  											"What's all this crap?  We're trying to catch cases where ensureExecutableCodeZone
  											 is called without first calling ensureWritableCodeZone, and vice verse.  But there are
  											 lots of exceptions where code is not modified but executability is turned on unnecessarily.
  											 The list of exceptions follows."
  											 currentAPISelector := self debugAPISelector.
  											self assert: (codeZoneIsExecutableNotWritable not
  														or: [currentAPISelector == #mapObjectReferencesInMachineCode:
  															or: [currentAPISelector == #cogitPostGCAction:
  															or: [currentAPISelector == #ceSICMiss:
  															or: [currentAPISelector == #ceCPICMiss:receiver:
  															or: [currentAPISelector == #unlinkSendsOf:isMNUSelector:
  															or: [currentAPISelector == #unlinkSendsTo:andFreeIf:
+ 															or: [currentAPISelector == #unlinkSendsToMethodsSuchThat:AndFreeIf:
+ 															or: [currentAPISelector == #followMovableLiteralsAndUpdateYoungReferrers]]]]]]]])].
- 															or: [currentAPISelector == #followMovableLiteralsAndUpdateYoungReferrers]]]]]]])].
  				 backEnd makeCodeZoneExecutable.
  				 self cCode: nil inSmalltalk: [codeZoneIsExecutableNotWritable := true. debugAPISelector := self debugAPISelector]]]!

Item was changed:
  ----- Method: SpurMemoryManager class>>initializeWithOptions: (in category 'class initialization') -----
  initializeWithOptions: optionsDictionary
  	"SpurMemoryManager initializeWithOptions: Dictionary new"
  
  	super initializeWithOptions: optionsDictionary.
  	InitializationOptions
+ 		at: #SPURVM put: true;
  		at: #Spur32BitMemoryManager ifAbsentPut: false;
  		at: #Spur64BitMemoryManager ifAbsentPut: false.
  	self initialize.
  	self initBytesPerWord: (self == SpurMemoryManager
  								ifTrue: [optionsDictionary at: #BytesPerWord ifAbsent: [4]]
  								ifFalse: [self wordSize]).
  
  	self initializeObjectHeaderConstants. "Initializes BaseHeaderSize so do early"
  	self initializeSpurObjectRepresentationConstants.
  	self initializeSpecialObjectIndices.
  	self initializeCompactClassIndices.
  	self initializePrimitiveErrorCodes.
  
  	SpurGenerationScavenger initialize!

Item was changed:
  ----- Method: TSendNode>>isNullCCode (in category 'testing') -----
  isNullCCode
  	| node |
+ 	(receiver isConstant
+ 	 and: [(receiver value == true and: [selector == #ifFalse:])
+ 		or: [receiver value == false and: [selector == #ifTrue:]]]) ifTrue:
+ 		[^true].
  	(#(cCode: cCode:inSmalltalk:) includes: selector) ifFalse:
  		[^false].
  	"all of cCode: nil ..., cCode: []..., cCode: '' are null"
  	node := arguments first.
  	node isConstant ifTrue:
  		[^(node value isString
  		   and: [node value notEmpty]) not].
  	^node hasEffect not!

Item was added:
+ ----- Method: TStmtListNode>>isNullCCode (in category 'testing') -----
+ isNullCCode
+ 	^statements allSatisfy: #isNullCCode!



More information about the Vm-dev mailing list