Hi,
While building the VM from generator.image through eval handler, I
noticed spurious blank lines in the log output. I created a changeset
that removes these and creates a compact log (all in VMMaker package).
My generator.image only throws up local repos for MC. smalltalkhub.com
seems to be down. How do I upload the patch to VMMaker mainline?
Regards .. Subbu
'From Pharo5.0 of 16 April 2015 [Latest update: #50771] on 16 April 2017 at 12:00:57.230077 am'!
"Change Set: fixextracr
Date: 15 April 2017
Author: kks
<your descriptive text goes here>"!
!CCodeGenerator methodsFor: 'C code generator' stamp: 'kks 4/15/2017 22:30'!
emitCAPIExportHeaderOn: aStream
"Store prototype declarations for all non-inlined methods on the given stream."
| nonInlineMethods usedConstants |
nonInlineMethods := self sortMethods: (methods select: [:m| m isAPIMethod]).
nonInlineMethods do:
[:m|
m static ifTrue:
[logger show: m selector, ' excluded from export API because it is static'; cr]].
self emitCFunctionPrototypes: nonInlineMethods on: aStream.
self emitGlobalCVariablesOn: aStream.
usedConstants := self emitCMacros: nonInlineMethods on: aStream.
self emitCConstants: usedConstants on: aStream! !
!CCodeGenerator methodsFor: 'inlining' stamp: 'kks 4/15/2017 22:11'!
reportShouldNotBeRemoved: removed varList: varList
"Report whether any of the removed methods are still used."
| varListAsStrings shouldNotBeRemoved |
varListAsStrings := varList collect: [ :sym | sym asString ].
shouldNotBeRemoved := Set new.
removed do:
[:m|
m isAPIMethod ifTrue:
[shouldNotBeRemoved add: m selector]].
methods do:
[:m|
(m selector = #interpret
or: [removed includes: m selector]) ifFalse:
[m allCalls do:
[:sel|
(removed includesKey: sel) ifTrue:
[shouldNotBeRemoved add: sel]]]].
vmClass additionalSelectorTables do:
[:selectorTable|
selectorTable do:
[:selOrInteger|
selOrInteger isInteger ifFalse:
[(removed includesKey: selOrInteger) ifTrue:
[shouldNotBeRemoved add: selOrInteger]]]].
shouldNotBeRemoved do:
[:sel| | str |
str := String streamContents:
[:strm| | them |
strm
nextPutAll: 'Removed ';
nextPutAll: sel;
nextPutAll: ' because it refers to the local variable'.
them := (removed at: sel) freeVariableReferences asSet intersection: varListAsStrings.
them size > 1 ifTrue:
[strm nextPut: $s.
them := self sortStrings: them].
them do: [:var| strm space; nextPutAll: var].
strm
nextPutAll: ' of interpret.';
cr;
nextPutAll: 'But it is either used outside of interpret or exported!!!!';
cr].
logger show: str.
self inform: str]! !
!CCodeGenerator methodsFor: 'inlining' stamp: 'kks 4/15/2017 22:12'!
collectInlineList: inlineFlagOrSymbol
"Make a list of methods that should be inlined. If inlineFlagOrSymbol == #asSpecified
only inline methods marked with <inline: true>. If inlineFlagOrSymbol == #asSpecifiedOrQuick
only inline methods marked with <inline: true> or methods that are quick (^constant, ^inst var)."
"Details: The method must not include any inline C, since the
translator cannot currently map variable names in inlined C code.
Methods to be inlined must be small or called from only one place."
| selectorsOfMethodsNotToInline callsOf |
self assert: (#(true false asSpecified asSpecifiedOrQuick) includes: inlineFlagOrSymbol).
selectorsOfMethodsNotToInline := Set new: methods size.
selectorsOfMethodsNotToInline addAll: macros keys.
apiMethods ifNotNil:
[selectorsOfMethodsNotToInline addAll: apiMethods keys].
methods do:
[:m|
m isStructAccessor ifTrue:
[selectorsOfMethodsNotToInline add: m selector]].
"build dictionary to record the number of calls to each method"
callsOf := Dictionary new: methods size * 2.
methods keysAndValuesDo:
[:s :m|
(m isRealMethod
and: [self shouldGenerateMethod: m]) ifTrue:
[callsOf at: s put: 0]].
"For each method, scan its parse tree once or twice to:
1. determine if the method contains unrenamable C code or declarations or has a C builtin
2. determine how many nodes it has
3. increment the sender counts of the methods it calls"
inlineList := Set new: methods size * 2.
(methods reject: [:m| selectorsOfMethodsNotToInline includes: m selector]) do:
[:m| | inlineIt hasUnrenamableCCode nodeCount |
((breakSrcInlineSelectors includes: m selector)
and: [breakOnInline isNil]) ifTrue:
[self halt].
inlineIt := #dontCare.
(translationDict includesKey: m selector)
ifTrue: [hasUnrenamableCCode := true]
ifFalse:
[hasUnrenamableCCode := m hasUnrenamableCCode.
nodeCount := 0.
m parseTree nodesDo:
[:node|
node isSend ifTrue:
[callsOf
at: node selector
ifPresent:
[:senderCount| callsOf at: node selector put: senderCount + 1]].
nodeCount := nodeCount + 1].
inlineIt := m extractInlineDirective]. "may be true, false, #always, #never or #dontCare"
(hasUnrenamableCCode or: [inlineIt == false])
ifTrue: "don't inline if method has C code or contains negative inline directive"
[inlineIt == true ifTrue:
[logger
nextPutAll: 'failed to inline ';
nextPutAll: m selector;
nextPutAll: ' as it contains unrenamable C declarations or C code';
cr; flush].
selectorsOfMethodsNotToInline add: m selector]
ifFalse:
[(inlineFlagOrSymbol caseOf: {
[#asSpecified] -> [inlineIt == true].
[#asSpecifiedOrQuick] -> [inlineIt == true
or: [self isQuickCompiledMethod: m compiledMethod]].
[true] -> [nodeCount < 40 or: [inlineIt == true]].
[false] -> [false]})
ifTrue: "inline if method has no C code and is either small or contains inline directive"
[inlineList add: m selector]
ifFalse:
[(#(asSpecified asSpecifiedOrQuick) includes: inlineFlagOrSymbol) ifTrue:
[selectorsOfMethodsNotToInline add: m selector]]]].
(#(asSpecified asSpecifiedOrQuick) includes: inlineFlagOrSymbol)
ifTrue:
[methods do: [:m| m inline ifNil: [m inline: (inlineList includes: m selector)]]]
ifFalse:
[callsOf associationsDo:
[:assoc|
(assoc value = 1
and: [(selectorsOfMethodsNotToInline includes: assoc key) not]) ifTrue:
[inlineList add: assoc key]]]! !
!CCodeGenerator methodsFor: 'error notification' stamp: 'kks 4/15/2017 22:02'!
checkClassForNameConflicts: aClass
"Verify that the given class does not have constant, variable, or method names that conflict with
those of previously added classes. Raise an error if a conflict is found, otherwise just return."
"check for constant name collisions in class pools"
aClass classPool associationsDo:
[:assoc |
(constants includesKey: assoc key) ifTrue:
[self error: 'Constant ', assoc key, ' was defined in a previously added class']].
"and in shared pools"
(aClass sharedPools reject: [:pool| pools includes: pool]) do:
[:pool |
pool bindingsDo:
[:assoc |
(constants includesKey: assoc key) ifTrue:
[self error: 'Constant ', assoc key, ' was defined in a previously added class']]].
"check for instance variable name collisions"
(aClass inheritsFrom: VMStructType) ifFalse:
[(self instVarNamesForClass: aClass) do:
[:varName |
(variables includes: varName) ifTrue:
[self error: 'Instance variable ', varName, ' was defined in a previously added class']]].
"check for method name collisions"
aClass selectors do:
[:sel | | tmeth meth |
((self shouldIncludeMethodFor: aClass selector: sel)
and: [(tmeth := methods at: sel ifAbsent: nil) notNil
and: [(aClass isStructClass and: [(aClass isAccessor: sel)
and: [(methods at: sel) isStructAccessor]]) not
and: [(meth := aClass >> sel) isSubclassResponsibility not
and: [(aClass includesBehavior: tmeth definingClass) not]]]]) ifTrue:
[((aClass >>sel) pragmaAt: #option:)
ifNil: [self error: 'Method ', sel, ' was defined in a previously added class.']
ifNotNil:
[logger
show: 'warning, method ', aClass name, '>>', sel storeString,
' overrides ', tmeth definingClass, '>>', sel storeString;
cr]]]! !
!CCodeGenerator methodsFor: 'utilities' stamp: 'kks 4/15/2017 21:28'!
localizeGlobalVariables
| candidates elected localized |
"find all globals used in only one method"
candidates := globalVariableUsage select: [:e | e size = 1].
"Don't localize globals; nor those that are only assigned to; they're for debugging..."
(candidates keys select: [:k| (vmClass mustBeGlobal: k)
or: [(self methodNamed: (globalVariableUsage at: k) anyOne)
ifNil: [false]
ifNotNil: [:m| (m readsVariable: k) not]]]) do:
[:k| candidates removeKey: k].
elected := Set new.
localized := Dictionary new. "for an ordered report"
"move any suitable global to be local to the single method using it"
candidates keysAndValuesDo:
[:key :targets |
targets do:
[:name |
(methods at: name ifAbsent: []) ifNotNil:
[:procedure | | newDeclaration |
(procedure isRealMethod
and: [self shouldGenerateMethod: procedure]) ifTrue:
[(localized at: name ifAbsentPut: [SortedCollection new]) add: key.
elected add: (procedure locals add: key).
newDeclaration := variableDeclarations at: key ifAbsent: ['sqInt ', key].
(self initializerForInstVar: key inStartClass: procedure definingClass) ifNotNil:
[:initializerNode|
newDeclaration := String streamContents:
[:s|
s nextPutAll: newDeclaration; nextPutAll: ' = '.
initializerNode emitCCodeOn: s level: 0 generator: self]].
procedure declarationAt: key put: newDeclaration.
variableDeclarations removeKey: key ifAbsent: []]]]].
logger ifNotNil:
[localized keys asSortedCollection do:
[:name|
(localized at: name) do:
[:var|
logger show: var, ' localised to ', name; cr]]].
elected do: [:ea| (variables includes: ea) ifTrue: [self checkDeleteVariable: ea]].
variables removeAllFoundIn: elected! !
!CCodeGenerator methodsFor: 'utilities' stamp: 'kks 4/15/2017 22:05'!
removeVariable: aName
"Remove the given (instance) variable from the code base."
self removeVariable: aName
ifAbsent:
[(vmClass notNil
and: [vmClass isNonArgumentImplicitReceiverVariableName: aName]) ifFalse:
[logger
show: 'warning, variable '
, aName
, ' doesn''t exist or has already been removed';
cr]]! !
!CCodeGenerator methodsFor: 'utilities' stamp: 'kks 4/15/2017 22:05'!
reportRecursiveMethods
"Report in transcript all methods that can call themselves directly or indirectly or via a chain of N intermediate methods."
methods do: [: m | | visited calls newCalls sel called |
visited := translationDict keys asSet.
calls := m allCalls asOrderedCollection.
5 timesRepeat: [
newCalls := Set new: 50.
[calls isEmpty] whileFalse: [
sel := calls removeFirst.
sel = m selector ifTrue: [
logger show: m selector, ' is recursive'; cr.
] ifFalse: [
(visited includes: sel) ifFalse: [
called := self methodNamed: sel.
called = nil ifFalse: [ newCalls addAll: called allCalls ].
].
visited add: sel.
].
].
calls := newCalls asOrderedCollection.
].
].! !
!CCodeGenerator methodsFor: 'utilities' stamp: 'kks 4/15/2017 22:38'!
prepareMethods
| globals |
globals := Set new: 200.
globals addAll: variables.
methods
do: [ :m |
m locals , m args
do: [ :var |
(globals includes: var)
ifTrue: [ self
error:
'Local variable ''' , var , ''' may mask global when inlining '
, m selector ].
((methods at: var ifAbsent: [ nil ])
ifNil: [ false ]
ifNotNil: [ :m1 | m1 isStructAccessor not ])
ifTrue: [ logger
nextPutAll: 'Local variable name ''';
nextPutAll: var;
nextPutAll: ''' in ';
nextPutAll: m selector;
nextPutAll: ' may mask method when inlining';
cr ] ].
m bindClassVariablesIn: constants.
m prepareMethodIn: self ]! !
!OCUndeclaredVariableWarning methodsFor: 'correcting' stamp: 'kks 4/15/2017 21:20'!
defaultAction
| varName className selector |
className := self methodClass name .
selector := self methodNode selector.
varName := node name.
self methodNode selector ifNotNil: [self trace: className, '>>', selector, ' ']
ifNil: [self traceCr:''].
self traceCr: '(' , varName , ' is Undeclared) '.
^super defaultAction ifNil: [
Undeclared at: varName asSymbol put: nil.
OCUndeclaredVariable new name: varName asSymbol]! !
