VMMaker scripts

1 - Load VMMaker

| manifest load |
manifest := #(	"('http://source.squeak.org/FFI'					1	('FFI-Pools' 'FFI-Kernel')) already in Pharo"
				('http://source.squeak.org/VMMaker'				6	('Balloon-Engine-Pools' 'BytecodeSets.spur' 'VMMaker.oscog' 'Cog' 'CogTools' 'ImageFormat'))
				('http://source.squeak.org/VMMaker'				0	('VMMakerCompatibilityForPharo6'))
				('http://ss3.gemstone.com/ss/MethodMassage'		3	('MethodMassage' 'MethodMassageCompatibility'))
				('http://www.squeaksource.com/AioPlugin'		7	('VMConstruction-Plugins-AioPlugin.oscog'))
				"('http://www.squeaksource.com/Alien'			0	('Alien-Core' 'Alien-Tests-Core' 'Alien-Win32')) already in Pharo"
				"('http://www.squeaksource.com/FreeTypePlus'	5	('FreeType')) can't load this.  it is toxic to Squeak 4.5"
				"('http://www.squeaksource.com/FreetypePlugin'	8	('Freetype-Plugin')) hence we can do without this"
				"('http://www.squeaksource.com/OSProcess'		4	('OSProcess')) appears to conflict with OSSVMProcess"
				('http://www.squeaksource.com/OSProcessPlugin'	9	('VMConstruction-Plugins-OSProcessPlugin.oscog'))
				"('http://www.squeaksource.com/rb'				5	('AST-Core' 'AST-Semantic' 'AST-Tests-Core' 'AST-Tests-Semantic' 'Refactoring-Changes' 'Refactoring-Core' 'Refactoring-Environment' 'Refactoring-Tests-Changes' 'Refactoring-Tests-Core' 'Refactoring-Tests-Environment' 'Refactoring-Squeak-Platform')) already in Pharo"
				"This for the Klatt speech synthesiser, but seems to be AWOL"
				('http://www.squeaksource.com/Speech'			2	('SharedPool-Speech' ))
				('http://www.squeaksource.com/XDCP'				9	('VMConstruction-Plugins-XDisplayControlPlugin.oscog' ))
				('http://www.squeaksource.com/Balloon3D'		9	('Balloon3D-Constants' 'Balloon3D-Plugins'  ))
				('http://www.squeaksource.com/Cryptography'		9	('CryptographyPlugins'  ))
				('http://smalltalkhub.com/mc/Alistair/FileAttributesPlugin/main'		9	('FileAttributesPlugin.oscog'  ))
				('http://ss3.gemstone.com/ss/AndreasSystemProfiler'	9	('AndreasProfiler'))
				('http://www.squeaksource.com/Printf'			5	('Printf'))
				).

load := (manifest collect:
				[:tuple|
				[:path :order :packages| | repository |
				repository := MCHttpRepository
								location: path
								user: 'squeak'
								password: 'squeak'.
				MCRepositoryGroup default addRepository: repository.
				{repository. order. packages}] valueWithArguments: tuple])
			sort: [:a :b| a second <= b second].

#(	"'FT2Constants.st'" ) do:
	[:fileName| (FileLocator cwd / fileName) fileIn].

load do:
	[:tuple|
	 [:repository :order :packages|
	  packages do:
		[:package | | packageVersions latestVersion |
		"We need to filter-out branches of unbranched packages, but can't assume
		the package list is (reverse) ordered."
		packageVersions := ((repository retrieveVersionsWithPackageNames: Set new) "e.g. Set with: #('Alien-Core' 'IgorStasenko' 71 'Alien-Core-IgorStasenko.71.mcz')"
						select: [ :v | v first = package and: [(v last at: package size + 1) = $-]])
						asSortedCollection: [ :a :b | a third < b third ].
		latestVersion := packageVersions last fourth.
		[| version |
		version := ((MCCacheRepository default includesVersionNamed: latestVersion)
					ifTrue: [MCCacheRepository default]
					ifFalse: [repository]) loadVersionFromFileNamed: latestVersion.
		 version load.
		 version workingCopy repositoryGroup addRepository: repository]
			on: Warning
			do: [:ex|
				((ex messageText beginsWith: 'This package depends on the following classes')
				 or: [ex messageText beginsWith: 'About to serialize an empty diffy version.']) ifFalse:
					[ex pass].
				ex resume]]]
		valueWithArguments: tuple].


#('Cog' 'CogTools' 'VMMaker')
	do: [ :pkg | 
		(RPackageSet named: pkg) definedClasses do:
			[ :c | 
			 c organization sortCategories.
			 c class organization sortCategories]].

2 - Generation Benchs

Object subclass: #MyClass
	instanceVariableNames: ''
	classVariableNames: 'MyClassVar MyNilClassVar'
	poolDictionaries: ''
	category: 'CGenerationBenchmarks'!

!MyClass methodsFor: 'meta' stamp: 'GuillermoPolito 5/22/2019 10:52'!
instantiation

	^ Object new! !


!MyClass methodsFor: 'control-flow' stamp: 'GuillermoPolito 5/22/2019 11:00'!
returnNothing! !

!MyClass methodsFor: 'control-flow' stamp: 'GuillermoPolito 5/22/2019 10:59'!
returnSomething

	^ 1! !

!MyClass methodsFor: 'control-flow' stamp: 'GuillermoPolito 5/22/2019 11:06'!
ifNilIfNotNil

	self foo
		ifNil: [ 1 . self foo ]
		ifNotNil: [ self foo. 17  ]! !

!MyClass methodsFor: 'control-flow' stamp: 'GuillermoPolito 5/22/2019 11:07'!
ifTrueIfFalse

	self foo
		ifTrue: [ 1 . self foo ]
		ifFalse: [ self foo. 17  ]! !

!MyClass methodsFor: 'control-flow' stamp: 'GuillermoPolito 5/22/2019 11:01'!
valueifTrueIfFalse

	^ self foo
		ifTrue: [ 1 ]
		ifFalse: [ 17 ]! !

!MyClass methodsFor: 'control-flow' stamp: 'GuillermoPolito 5/22/2019 11:05'!
ifNilIfNotNilWithArg

	self foo
		ifNil: [ 1 . self foo ]
		ifNotNil: [ :v | self foo. 17  ]! !

!MyClass methodsFor: 'control-flow' stamp: 'GuillermoPolito 5/22/2019 11:10'!
ifNilOnNotNilClassVar

	MyNilClassVar
		ifNil: [ self foo ]
		ifNotNil: [ self foo2 ]! !


!MyClass methodsFor: 'literals' stamp: 'GuillermoPolito 5/22/2019 10:57'!
classVariables

	^ MyClassVar! !

!MyClass methodsFor: 'literals' stamp: 'GuillermoPolito 5/22/2019 10:50'!
true

	^ true! !

!MyClass methodsFor: 'literals' stamp: 'GuillermoPolito 5/22/2019 10:57'!
superLongInt

	^ 10737418230000000000000000000000000000000000000000000000000000000000000000000! !

!MyClass methodsFor: 'literals' stamp: 'GuillermoPolito 5/22/2019 10:57'!
classVariableAssignment

	MyClassVar := 17.
	^ MyClassVar! !

!MyClass methodsFor: 'literals' stamp: 'GuillermoPolito 5/22/2019 10:50'!
false

	^ false! !

!MyClass methodsFor: 'literals' stamp: 'GuillermoPolito 5/22/2019 10:53'!
string

	^ 'aString'! !

!MyClass methodsFor: 'literals' stamp: 'GuillermoPolito 5/22/2019 10:50'!
nil

	^ nil! !


!MyClass methodsFor: 'collections' stamp: 'GuillermoPolito 5/22/2019 10:57'!
collectWithInlining

	"^ #(1 2 3) collect: [:e | e * 2 ]"
	"^ { 1 . 2 . 3 } collect: [:e | e * 2 ]"
	^ self collection collect: [:e | self methodToInline ]! !

!MyClass methodsFor: 'collections' stamp: 'GuillermoPolito 5/22/2019 10:56'!
collect

	"^ #(1 2 3) collect: [:e | e * 2 ]"
	"^ { 1 . 2 . 3 } collect: [:e | e * 2 ]"
	^ self collection collect: [:e | e * 2 ]! !


!MyClass methodsFor: 'exceptions' stamp: 'GuillermoPolito 5/22/2019 10:56'!
onDo

	[ self foo1 ] on: Error do: [ 1 ]! !

!MyClass methodsFor: 'exceptions' stamp: 'GuillermoPolito 5/22/2019 10:56'!
ensure

	[ 1+1 ] ensure: [ self closeFile ]! !


!MyClass methodsFor: 'messages' stamp: 'GuillermoPolito 5/22/2019 10:58'!
binaryMessageWithSameCPrecedence

	^ 3 * 4 + 2! !

!MyClass methodsFor: 'messages' stamp: 'GuillermoPolito 5/22/2019 10:57'!
binaryMessageWithDifferentCPrecedence

	^ 2 + 3 * 4! !

!MyClass methodsFor: 'messages' stamp: 'GuillermoPolito 5/22/2019 10:58'!
unaryMessage

	self unary! !

!MyClass methodsFor: 'messages' stamp: 'GuillermoPolito 5/22/2019 10:58'!
keywordMessage

	self keyword: 1 message: self foo! !


!MyClass methodsFor: 'support' stamp: 'GuillermoPolito 5/22/2019 10:56'!
methodToInline

	^ self string! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

MyClass class
	instanceVariableNames: ''!

!MyClass class methodsFor: 'testing' stamp: 'GuillermoPolito 5/22/2019 11:09'!
shouldGenerateDeadCode

	^ false! !


!MyClass class methodsFor: 'acce' stamp: 'GuillermoPolito 5/22/2019 10:35'!
moduleExportsName

	 ^ self moduleName! !


!MyClass class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/22/2019 10:30'!
namesOfVariablesToLocalize
	^#()! !

!MyClass class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/22/2019 10:34'!
moduleNameAndVersion

	^ self moduleName! !

!MyClass class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/22/2019 10:35'!
methodsToBePruned
	"Since sharing between plugins means that normal pruning
	 can't be done, allow plugins that want to prune specific methods."
	^#()! !

!MyClass class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/22/2019 10:32'!
additionalSelectorTables
	
	^ #()! !

!MyClass class methodsFor: 'as yet unclassified' stamp: 'GuillermoPolito 5/22/2019 10:35'!
preambleCCode
	"Defining this method to answer a string dumps that string in VMPluginCodeGenerator>>emitCHeaderOn:"
	^nil! !


!MyClass class methodsFor: 'class initialization' stamp: 'GuillermoPolito 5/22/2019 11:11'!
initialize

	MyClassVar := 42.
	MyNilClassVar := nil! !


!MyClass class methodsFor: 'accessubg' stamp: 'GuillermoPolito 5/22/2019 10:34'!
moduleName

	^ self name! !


!MyClass class methodsFor: 'translation' stamp: 'GuillermoPolito 5/22/2019 10:29'!
requiredMethodNames: options
	"Answer a list of method names that should be retained for export or other
	 support reasons.  These are typically entry-points that unless explicitly noted
	 will be deleted by the code generator since it will assume these are not used."
	^#()! !

!MyClass class methodsFor: 'translation' stamp: 'GuillermoPolito 5/22/2019 10:29'!
prepareToBeAddedToCodeGenerator: aCCodeGenerator 
	"Hook for translation.  e.g. allows a subclass to override its
	 superclass's methods by deleting them before it adds its own."! !

!MyClass class methodsFor: 'translation' stamp: 'GuillermoPolito 5/22/2019 10:29'!
declareCVarsIn: aCCodeGenerator 
	"Declare any additional variables and/or add type declarations for existing variables."! !

MyClass initialize!

3 - Loading Generation benchs

CodeImporter evaluateFileNamed: 'benchs.st'

4 - Generate benchs

MyClass initialize.

codeGenerator := VMPluginCodeGenerator new.
codeGenerator pluginClass: MyClass.
codeGenerator addClass: MyClass.
codeGenerator doInlining: true.

codeGenerator inferTypesForImplicitlyTypedVariablesAndMethods.


String streamContents: [ :stream |
	codeGenerator
		emitCCodeOn: stream
		doInlining: true
		doAssertions: false ]