--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCCodeGen.st Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,574 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCCodeGen
+ instanceVariableNames:'compilerStack compiledParser methodCache currentMethod constants
+ returnVariable arguments idCache'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Compiler-Codegen'
+!
+
+!PPCCodeGen class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self on: PPCArguments default
+!
+
+on: aPPCArguments
+ "return an initialized instance"
+
+ ^ self basicNew
+ initialize;
+ arguments: aPPCArguments
+! !
+
+!PPCCodeGen methodsFor:'accessing'!
+
+arguments: args
+ arguments := args
+!
+
+constants
+ ^ constants
+!
+
+currentMethod
+ ^ currentMethod
+!
+
+currentNonInlineMethod
+ ^ compilerStack
+ detect:[:m | m isInline not ]
+ ifNone:[ self error: 'No non-inlined method']
+
+ "Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+currentReturnVariable
+ ^ currentMethod returnVariable
+!
+
+ids
+ ^ idCache keys
+!
+
+methodCategory
+ ^ 'generated'
+!
+
+methodDictionary
+ ^ methodCache
+!
+
+methodFor: object
+ | id |
+ id := self idFor: object.
+ ^ methodCache at: id ifAbsent: [ nil ]
+! !
+
+!PPCCodeGen methodsFor:'code generation'!
+
+add: string
+ currentMethod add: string.
+!
+
+addConstant: value as: name
+ (constants includesKey: name) ifTrue:[
+ (constants at: name) ~= value ifTrue:[
+ self error:'Duplicate constant!!'.
+ ].
+ ^ self.
+ ].
+ constants at: name put: value
+
+ "Modified: / 29-05-2015 / 07:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+addOnLine: string
+ currentMethod addOnLine: string.
+!
+
+addVariable: name
+ ^ self currentNonInlineMethod addVariable: name
+
+ "Modified: / 23-04-2015 / 17:34:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+call: anotherMethod
+ currentMethod add: anotherMethod call.
+!
+
+callOnLine: anotherMethod
+ currentMethod addOnLine: anotherMethod call.
+!
+
+dedent
+ currentMethod dedent
+!
+
+indent
+ currentMethod indent
+!
+
+nl
+ currentMethod nl
+!
+
+smartRemember: parser to: variableName
+ parser isContextFree ifTrue: [
+ self codeAssign: 'context lwRemember.'
+ to: variableName.
+ ] ifFalse: [
+ self codeAssign: 'context remember.'
+ to: variableName.
+ ]
+!
+
+smartRestore: parser from: mementoName
+ parser isContextFree ifTrue: [
+ self add: 'context lwRestore: ', mementoName, '.'.
+ ] ifFalse: [
+ self add: 'context restore: ', mementoName, '.'.
+ ]
+! !
+
+!PPCCodeGen methodsFor:'coding'!
+
+code:aStringOrBlockOrRBParseNode
+ currentMethod code: aStringOrBlockOrRBParseNode
+
+ "Created: / 01-06-2015 / 23:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeAssign: code to: variable
+ self assert: variable isNil not.
+
+ "TODO JK: Hack alert, whatever is magic constant!!"
+ (variable == #whatever) ifFalse: [
+ "Do not assign, if somebody does not care!!"
+ self add: variable ,' := ', code.
+ ]
+!
+
+codeAssignParsedValueOf:aBlock to:aString
+ | tmpVarirable method |
+
+ self assert:aBlock isBlock.
+ self assert:aString isNil not.
+ tmpVarirable := returnVariable.
+ returnVariable := aString.
+ method := [
+ aBlock value
+ ] ensure:[ returnVariable := tmpVarirable ].
+ method isInline ifTrue:[
+ self callOnLine:method
+ ] ifFalse:[
+ self codeEvaluateAndAssign:(method call) to:aString.
+ ]
+
+ "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeBlock: contents
+ currentMethod codeBlock: contents
+
+ "Created: / 01-06-2015 / 22:35:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeClearError
+ self add: 'self clearError.'.
+!
+
+codeComment: string
+ currentMethod add: '"', string, '"'.
+!
+
+codeDot
+ self addOnLine:'.'.
+
+ "Created: / 16-06-2015 / 06:09:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeError
+ self add: 'self error: ''message notspecified''.'.
+!
+
+codeError: errorMessage
+ self add: 'self error: ''', errorMessage, '''.'
+!
+
+codeError: errorMessage at: position
+ self add: 'self error: ''', errorMessage, ''' at: ', position asString, '.'
+!
+
+codeEvaluate: selector argument: argument on: variable
+ self assert: variable isNil not.
+
+ "TODO JK: Hack alert, whatever is magic constant!!"
+ (variable == #whatever) ifFalse: [
+ "Do not assign, if somebody does not care!!"
+ self add: variable, ' ', selector,' ', argument.
+ ] ifTrue: [
+ "In case argument has a side effect"
+ self add: argument
+ ]
+!
+
+codeEvaluateAndAssign: argument to: variable
+ self assert: variable isNil not.
+
+ "TODO JK: Hack alert, whatever is magic constant!!"
+ (variable == #whatever) ifFalse: [
+ "Do not assign, if somebody does not care!!"
+ self add: variable ,' := ', argument.
+ ] ifTrue: [
+ "In case an argument has a side effect"
+ self add: argument.
+ ]
+!
+
+codeHalt
+ self add: 'self halt. '
+!
+
+codeHaltIfShiftPressed
+ arguments debug ifTrue: [
+ ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[
+ self add: 'Halt ifShiftPressed.'
+ ]
+ ]
+
+ "Modified: / 10-05-2015 / 07:39:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIf: condition then: then
+ self codeIf: condition then: then else: nil
+
+ "Created: / 16-06-2015 / 06:07:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIf: condition then: then else: else
+ currentMethod
+ add: '(';
+ code: condition;
+ addOnLine: ')'.
+ then notNil ifTrue:[
+ currentMethod
+ addOnLine:' ifTrue:';
+ codeBlock: then.
+ ].
+ else notNil ifTrue:[
+ currentMethod
+ addOnLine:' ifFalse:';
+ codeBlock: else.
+ ].
+ self codeDot.
+
+ "Created: / 01-06-2015 / 22:43:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 16-06-2015 / 06:09:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIfErrorThen: then
+ ^ self codeIf: 'error' then: then else: nil
+
+ "Created: / 16-06-2015 / 06:06:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeIfErrorThen: then else: else
+ ^ self codeIf: 'error' then: then else: else
+
+ "Created: / 16-06-2015 / 06:05:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeNextToken
+ self add: 'self nextToken.'
+
+ "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeProfileStart
+ self add: 'context methodInvoked: #', currentMethod methodName, '.'
+
+ "Created: / 01-06-2015 / 21:17:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeProfileStop
+ self add: 'context methodFinished: #', currentMethod methodName, '.'
+
+ "Created: / 01-06-2015 / 21:19:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeReturn
+ currentMethod isInline ifTrue: [
+ "If inlined, the return variable already holds the value"
+ ] ifFalse: [
+ arguments profile ifTrue:[
+ self codeProfileStop.
+ ].
+ self add: '^ ', currentMethod returnVariable
+ ].
+
+ "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeReturn: code
+ " - returns whatever is in code OR
+ - assigns whatever is in code into the returnVariable"
+ currentMethod isInline ifTrue:[
+ self codeEvaluateAndAssign: code to: currentMethod returnVariable.
+ ] ifFalse: [
+ arguments profile ifTrue:[
+ self codeProfileStop.
+ ].
+ self add: '^ ', code
+ ]
+
+ "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-06-2015 / 21:48:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeStoreValueOf: aBlock intoVariable: aString
+ | tmpVarirable method |
+ self assert: aBlock isBlock.
+ self assert: aString isNil not.
+
+ tmpVarirable := returnVariable.
+ returnVariable := aString.
+ method := [
+ aBlock value
+ ] ensure: [
+ returnVariable := tmpVarirable
+ ].
+
+ method isInline ifTrue: [
+ self callOnLine: method
+ ] ifFalse: [
+ self codeEvaluateAndAssign: (method call) to: aString.
+ ]
+
+ "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+codeTokenGuard: node ifFalse: codeBlock
+ | guard id |
+ guard := PPCTokenGuard on: node.
+ (guard makesSense) ifTrue: [
+ id := self idFor: guard firstToken.
+
+ self add: 'self ', id asString, ' ifFalse: ['.
+ self indent.
+ codeBlock value.
+ self dedent.
+ self add: '].'.
+ ]
+!
+
+codeTranscriptShow: text
+ (arguments profile) ifTrue: [
+ self add: 'Transcript show: ', text storeString, '; cr.'.
+ ]
+! !
+
+!PPCCodeGen methodsFor:'ids'!
+
+asSelector: string
+ "e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"
+
+ | toUse |
+
+ toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ].
+ (toUse isEmpty or: [ toUse first isLetter not ])
+ ifTrue: [ toUse := 'v', toUse ].
+ toUse first isUppercase ifFalse:[
+ toUse := toUse copy.
+ toUse at: 1 put: toUse first asLowercase
+ ].
+ ^toUse
+
+ "Modified: / 10-05-2015 / 07:29:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+idFor: object
+ self assert: (object canHavePPCId).
+ ^ self idFor: object prefixed: object prefix suffixed: object suffix
+!
+
+idFor: object prefixed: prefix
+ ^ self idFor: object prefixed: prefix suffixed: ''
+!
+
+idFor: object prefixed: prefix suffixed: suffix
+ | name id |
+ ^ idCache at: object ifAbsentPut: [
+ ((object canHavePPCId) and: [object name isNotNil]) ifTrue: [
+ "Do not use prefix, if there is a name"
+ name := self asSelector: (object name asString).
+ id := (name, suffix) asSymbol.
+
+ "Make sure, that the generated ID is uniqe!!"
+ (idCache includes: id) ifTrue: [
+ (id, '_', idCache size asString) asSymbol
+ ] ifFalse: [
+ id
+ ]
+ ] ifFalse: [
+ (prefix, '_', (idCache size asString), suffix) asSymbol
+ ]
+ ]
+!
+
+idFor: object suffixed: suffix
+ self assert: (object isKindOf: PPCNode) description: 'Shold use PPCNode for ids'.
+ ^ self idFor: object prefixed: object prefix suffixed: suffix effect: #none
+! !
+
+!PPCCodeGen methodsFor:'initialization'!
+
+copy: parser
+ self halt: 'deprecated?'.
+ ^ parser transform: [ :p | p copy ].
+!
+
+initialize
+ super initialize.
+
+ compilerStack := Stack new.
+ methodCache := IdentityDictionary new.
+ constants := Dictionary new.
+ idCache := IdentityDictionary new.
+! !
+
+!PPCCodeGen methodsFor:'profiling'!
+
+profileTokenRead: tokenName
+ arguments profile ifTrue: [
+ self add: 'context tokenRead: ', tokenName storeString, '.'
+ ]
+! !
+
+!PPCCodeGen methodsFor:'support'!
+
+cache: id as: value
+ methodCache at: id put: value.
+!
+
+cachedValue: id
+ ^ methodCache at: id ifAbsent: [ nil ]
+!
+
+cachedValue: id ifPresent: block
+ ^ methodCache at: id ifPresent: block
+!
+
+checkCache: id
+ | method |
+
+ "self halt: 'deprecated?'."
+
+ "Check if method is hand written"
+ method := compiledParser ifNotNil: [ compiledParser compiledMethodAt: id ifAbsent: [ nil ] ].
+ method ifNotNil: [ ^ PPCCompiledMethod new id: id; yourself ].
+
+ ^ self cachedValue: id
+!
+
+pop
+ | retval |
+ retval := compilerStack pop.
+ currentMethod := compilerStack isEmpty
+ ifTrue: [ nil ]
+ ifFalse: [ compilerStack top ].
+ ^ retval
+
+ "Modified: / 21-11-2014 / 12:27:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+push
+ compilerStack push: currentMethod.
+ (compilerStack size > 500 )ifTrue: [ self error: 'unless it is very complex grammar, there is an error somewhere' ]
+
+ "Modified: / 21-11-2014 / 12:27:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+startInline: id
+ | indentationLevel |
+ (methodCache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
+ indentationLevel := currentMethod indentationLevel.
+
+ currentMethod := PPCInlinedMethod new.
+ currentMethod id: id.
+ currentMethod returnVariable: returnVariable.
+ currentMethod indentationLevel: indentationLevel.
+ self push.
+
+ "Modified: / 01-06-2015 / 21:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+startMethod: id
+ (methodCache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
+
+ currentMethod := PPCMethod new.
+ currentMethod id: id.
+ currentMethod category: self methodCategory.
+
+ arguments profile ifTrue:[
+ self codeProfileStart.
+ ].
+ self push.
+
+ self cache: id as: currentMethod.
+
+ "Modified: / 01-06-2015 / 21:19:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+stopInline
+ ^ self pop.
+
+ "Modified: / 01-06-2015 / 21:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+stopMethod
+ self cache: currentMethod methodName as: currentMethod.
+
+ "arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ]."
+ ^ self pop.
+
+ "Modified: / 01-06-2015 / 21:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+top
+ ^ compilerStack top
+! !
+
+!PPCCodeGen methodsFor:'variables'!
+
+allocateReturnVariable
+ ^ self allocateReturnVariableNamed: 'retval'
+
+ "Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+allocateReturnVariableNamed: name
+ "Allocate (or return previously allocated one) temporary variable used for
+ storing a parser's return value (the parsed object)"
+ ^ currentMethod allocateReturnVariableNamed: name
+
+ "Created: / 15-06-2015 / 18:04:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+allocateTemporaryVariableNamed: preferredName
+ "Allocate a new variable with (preferably) given name.
+ Returns a real variable name that should be used."
+
+ ^ self currentNonInlineMethod allocateTemporaryVariableNamed: preferredName
+
+ "Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+