[squeak-dev] The Trunk: Compiler-eem.489.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jan 16 20:37:24 UTC 2023


Eliot Miranda uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-eem.489.mcz

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

Name: Compiler-eem.489
Author: eem
Time: 16 January 2023, 12:37:21.712938 pm
UUID: 1891e262-7e64-442a-bff9-969e0d570871
Ancestors: Compiler-mt.488

Add some utilities to compute static bytecode frequencies. If this is unwelcome LMK and I'll move them elsewhere. But I think this is generally interesting to Compiler wonks and does no harm.

=============== Diff against Compiler-mt.488 ===============

Item was added:
+ ----- Method: BytecodeEncoder class>>condensedFrequencyTable (in category 'utilities') -----
+ condensedFrequencyTable
+ 	"Answer an Array of quadruples, the indices, static frequency, percentage and
+ 	 name of the bytecodes in the image's methods."
+ 
+ 	"EncoderForSistaV1 condensedFrequencyTable"
+ 	"EncoderForV3PlusClosures condensedFrequencyTable"
+ 
+ 	| frequencies compound encodings total extractFirstEncoding |
+ 	frequencies := self frequencyTable.
+ 	compound := Dictionary new.
+ 	encodings := Dictionary new.
+ 	frequencies withIndexDo:
+ 		[:tuple :encodingPlusOne|
+ 		[:count :percentage :bcName|
+ 		compound
+ 			at: bcName
+ 			ifPresent: [:sum| compound at: bcName put: sum + count]
+ 			ifAbsentPut: count.
+ 		(encodings at: bcName ifAbsentPut: Set new) add: encodingPlusOne - 1]
+ 			valueWithArguments: tuple].
+ 	encodings keysAndValuesDo:
+ 		[:bcName :set| | elements range |
+ 		elements := OrderedCollection new.
+ 		[set isEmpty] whileFalse:
+ 			[range := set min to: set min.
+ 			 set remove: set min.
+ 			 [set includes: range last + 1] whileTrue:
+ 				[range := range first to: (set remove: range last + 1)].
+ 			 elements add: (range size = 1  ifTrue: [range first] ifFalse: [range])].
+ 		encodings at: bcName put: (elements size = 1 ifTrue: [elements first] ifFalse: [elements asArray])].
+ 
+ 	total := (frequencies collect: #first) sum.
+ 	extractFirstEncoding := [:tuple| | thisEncoding |
+ 								thisEncoding := tuple.
+ 								[thisEncoding isInteger] whileFalse: [thisEncoding := thisEncoding first].
+ 								thisEncoding].
+ 	^(compound associations collect:
+ 		[:assoc| | bcName count |
+ 		bcName := assoc key.
+ 		count := assoc value.
+ 		{ encodings at: bcName. count. count * 100.0 / total roundTo: 0.0001. bcName }]) sorted:
+ 			[:tupleA :tupleB|
+ 			tupleA second > tupleB second
+ 			or: [tupleA second = tupleB second and: [(extractFirstEncoding value: tupleA) < (extractFirstEncoding value: tupleB)]]]!

Item was added:
+ ----- Method: BytecodeEncoder class>>descriptionTable (in category 'utilities') -----
+ descriptionTable
+ 	"Attempt to answer an Array mapping bytecode indices to bytecode names, derived from the class comment.
+ 	 The name of the 0th byetcode is in the Array's first variable, the 255th in its 256'th, and so on."
+ 	| table s lastBC n m line |
+ 	lastBC := -1. n := 0.
+ 	table := Array new: 256 withAll: 'Unspecified'.
+ 	s := ReadStream on: self comment asString.
+ 	[line := s upTo: Character cr.
+ 	s peek = Character tab and: [(s next; peek) isDigit]] whileFalse.
+ 	s skip: -2.
+ 	[table last ~= 'Unspecified' or: [s atEnd]] whileFalse:
+ 		[[s peek = $*] whileTrue: [s next].
+ 		 s skipSeparators.
+ 		 s peek isDigit
+ 			ifTrue:
+ 				[n := Integer readFrom: s.
+ 				 n > lastBC "filter-out things like ''2 Byte Bytecodes'' etc"
+ 					ifTrue:
+ 						[m := (s skipSeparators; peek) = $- ifTrue:
+ 									[s next; skipSeparators.
+ 									 Integer readFrom: s].
+ 						line := s upTo: Character cr.
+ 						line := line allButFirst: (line findFirst: [:c| c isUppercase]) - 1.
+ 						m
+ 							ifNil: [table at: n + 1 put: line]
+ 							ifNotNil:
+ 								[table atAll: (n + 1 to: m + 1) put: line.
+ 								 n := m].
+ 						lastBC := n]
+ 					ifFalse:
+ 						[line := s upTo: Character cr]]
+ 			ifFalse: "i.e. skip additional notes on following line"
+ 				[line := s upTo: Character cr]].
+ 	^table
+ 
+ 	"EncoderForSistaV1 descriptionTable"!

Item was added:
+ ----- Method: BytecodeEncoder class>>frequencyTable (in category 'utilities') -----
+ frequencyTable
+ 	"Answer an Array of triples, the first triple being the static frequency, percentage and name of bytecode 0 in the image's
+ 	 methods, the second being the static frequency, precentage and name of bytecode 1, and so on upto bytecode 255."
+ 	| frequencies total |
+ 	frequencies := Array new: 256 withAll: 0.
+ 	self systemNavigation allMethodsSelect:
+ 		[:m|
+ 		m encoderClass == self ifTrue:
+ 			[m isQuick ifFalse:
+ 				[| i e b |
+ 				 i := m initialPC.
+ 				 e := m endPC.
+ 				 [i <= e] whileTrue:
+ 					[b := m at: i.
+ 					 frequencies at: b + 1 put: (frequencies at: b + 1) + 1.
+ 					 i := i + (self bytecodeSize: b)]]].
+ 		false].
+ 	total := frequencies sum / 100.0.
+ 	^self descriptionTable withIndexCollect:
+ 		[:decription :index|
+ 		{ frequencies at: index. (frequencies at: index) / total roundTo: 0.0001. decription }]
+ 
+ 	"EncoderForSistaV1 frequencyTable"
+ 	"EncoderForV3PlusClosures frequencyTable"!

Item was added:
+ ----- Method: EncoderForV3PlusClosures class>>descriptionTable (in category 'utilities') -----
+ descriptionTable
+ 	"Override to merge EncoderForV3's description table into EncoderForV3PlusClosure's"
+ 
+ 	| ours theirs |
+ 	ours := super descriptionTable.
+ 	theirs := superclass descriptionTable.
+ 	^ours withIndexCollect:
+ 		[:description :index|
+ 		description = 'Unspecified'
+ 			ifTrue: [theirs at: index]
+ 			ifFalse: [description]]!



More information about the Squeak-dev mailing list