diff -r b5316ef15274 -r f6f68d32de73 compiler/PPCCodeGen.st --- a/compiler/PPCCodeGen.st Mon Aug 17 12:13:16 2015 +0100 +++ b/compiler/PPCCodeGen.st Mon Aug 24 15:34:14 2015 +0100 @@ -3,8 +3,7 @@ "{ NameSpace: Smalltalk }" Object subclass:#PPCCodeGen - instanceVariableNames:'compilerStack compiledParser methodCache currentMethod constants - returnVariable arguments idGen' + instanceVariableNames:'clazz arguments' classVariableNames:'' poolDictionaries:'' category:'PetitCompiler-Compiler-Codegen' @@ -32,195 +31,176 @@ arguments := args ! -constants - ^ constants +clazz + ^ clazz +! + +clazz: aPPCClass + clazz := aPPCClass ! 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 " -! - -currentReturnVariable - ^ currentMethod returnVariable + ^ clazz currentMethod ! idGen - ^ idGen + ^ clazz idGen ! -idGen: anObject - idGen := anObject +idGen: idGenerator + ^ clazz idGen: idGenerator ! ids - ^ idGen ids + ^ clazz idGen ids ! 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. -! +!PPCCodeGen methodsFor:'caching'! -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 " -! - -addOnLine: string - currentMethod addOnLine: string. -! - -addVariable: name - ^ self currentNonInlineMethod addVariable: name - - "Modified: / 23-04-2015 / 17:34:02 / Jan Vrany " +cacheMethod: method as: id + ^ clazz store: method as: id ! -call: anotherMethod - currentMethod add: anotherMethod call. -! - -callOnLine: anotherMethod - currentMethod addOnLine: anotherMethod call. -! - -dedent - currentMethod dedent -! - -indent - currentMethod indent -! - -nl - currentMethod nl +cachedMethod: id + ^ clazz cachedMethod: id ! -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, '.'. - ] +cachedMethod: id ifPresent: aBlock + ^ clazz cachedMethod: id ifPresent: aBlock ! ! -!PPCCodeGen methodsFor:'coding'! +!PPCCodeGen methodsFor:'code'! -code:aStringOrBlockOrRBParseNode - currentMethod code: aStringOrBlockOrRBParseNode +code: aStringOrBlockOrRBParseNode + clazz currentMethod code: aStringOrBlockOrRBParseNode "Created: / 01-06-2015 / 23:49:11 / Jan Vrany " ! codeAssert: aCode - self add: 'self assert: (', aCode, ').'. -! - -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 ]. - self assert: (method isKindOf: PPCMethod). - method isInline ifTrue:[ - self callOnLine:method - ] ifFalse:[ - self codeEvaluateAndAssign:(method call) to:aString. - ] - - "Created: / 23-04-2015 / 18:21:51 / Jan Vrany " + self code: 'self assert: (', aCode, ').'. ! codeBlock: contents - currentMethod codeBlock: contents + clazz currentMethod codeBlock: contents "Created: / 01-06-2015 / 22:35:32 / Jan Vrany " ! codeCall: aMethod self assert: (aMethod isKindOf: PPCMethod). - self add: aMethod call. + self code: aMethod call. ! -codeClearError - self add: 'self clearError.'. -! - -codeComment: string - currentMethod add: '"', string, '"'. +codeCallOnLine: aMethod + self assert: (aMethod isKindOf: PPCMethod). + self codeOnLine: aMethod call. ! codeDot - self addOnLine:'.'. + self codeOnLine: '.'. "Created: / 16-06-2015 / 06:09:07 / Jan Vrany " ! -codeError - self add: 'self error: ''message notspecified''.'. +codeNl + self code: ''. +! + +codeOnLine:aStringOrBlockOrRBParseNode + clazz currentMethod codeOnLine: aStringOrBlockOrRBParseNode + + "Created: / 01-06-2015 / 23:49:11 / Jan Vrany " +! + +codeReturn + clazz currentMethod isInline ifTrue: [ + "If inlined, the return variable already holds the value" + ] ifFalse: [ + arguments profile ifTrue:[ + self codeProfileStop. + ]. + self code: '^ ', clazz currentMethod returnVariable + ]. + + "Created: / 23-04-2015 / 18:01:05 / Jan Vrany " + "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany " +! + +codeReturn: code + " - returns whatever is in code OR + - assigns whatever is in code into the returnVariable" + clazz currentMethod isInline ifTrue:[ + self codeEvaluateAndAssign: code to: clazz currentMethod returnVariable. + ] ifFalse: [ + arguments profile ifTrue:[ + self codeProfileStop. + ]. + self code: '^ '. + self codeOnLine: code + ] + + "Created: / 23-04-2015 / 18:01:05 / Jan Vrany " + "Modified: / 01-06-2015 / 21:48:51 / Jan Vrany " ! -codeError: errorMessage - self add: 'self error: ''', errorMessage, '''.' +codeReturnParsedValueOf: aBlock + | method | + + method := clazz parsedValueOf: aBlock to: clazz currentReturnVariable. + + method isInline ifTrue:[ + self codeCallOnLine: method. + self codeReturn: clazz currentReturnVariable. + ] ifFalse:[ + self codeReturn: method call. + + ] + + "Created: / 23-04-2015 / 18:21:51 / Jan Vrany " +! ! + +!PPCCodeGen methodsFor:'code assignment'! + +codeAssign: stringOrBlock to: variable + self assert: variable isNil not. + + stringOrBlock isString ifTrue: [ + ^ self codeAssignString: stringOrBlock to: variable + ]. + + (stringOrBlock isKindOf: BlockClosure) ifTrue: [ + ^ self codeAssignParsedValueOf: stringOrBlock to: variable + ]. + + self error: 'unknown argument'. ! -codeError: errorMessage at: position - self add: 'self error: ''', errorMessage, ''' at: ', position asString, '.' +codeAssignParsedValueOf:aBlock to: variable + | method | + method := clazz parsedValueOf: aBlock to: variable . + + method isInline ifTrue:[ + self codeCallOnLine:method + ] ifFalse:[ + self codeAssignString: (method call) to: variable. + ] + + "Created: / 23-04-2015 / 18:21:51 / Jan Vrany " +! + +codeAssignString: string 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 code: variable ,' := ', string. + ] ! codeEvaluate: selector argument: argument on: variable @@ -229,65 +209,110 @@ "TODO JK: Hack alert, whatever is magic constant!!" (variable == #whatever) ifFalse: [ "Do not assign, if somebody does not care!!" - self add: variable, ' ', selector,' ', argument. + self code: variable, ' ', selector,' ', argument. ] ifTrue: [ "In case argument has a side effect" - self add: argument + self code: argument + ] +! + +codeEvaluateAndAssign: stringOrBlock to: variable + "Contrary to codeAssign:to: I always put code onto the stream" + stringOrBlock isString ifTrue: [ + self codeEvaluateAndAssignString: stringOrBlock to: variable + ] ifFalse: [ + self assert: (stringOrBlock isKindOf: BlockClosure). + self codeEvaluateAndAssignParsedValueOf: stringOrBlock to: variable ] ! -codeEvaluateAndAssign: argument to: variable +codeEvaluateAndAssignParsedValueOf: aBlock to: variable + | method | + method := clazz parsedValueOf: aBlock to: variable . + + + method isInline ifFalse: [ + self codeEvaluateAndAssignString: method call to: variable. + ] ifTrue: [ + "if inlined, the variable is already filled in, just call it" + self code: method call + ] +! + +codeEvaluateAndAssignString: string to: variable + "Contrary to codeAssign:to: I always put code onto the stream" + self assert: string isString. 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. + self codeAssignString: string to: variable ] ifTrue: [ - "In case an argument has a side effect" - self add: argument. + "In case code has a side effect" + self code: string. ] +! ! + +!PPCCodeGen methodsFor:'code debugging'! + +codeComment: string + self code: '"', string, '"'. ! codeHalt - self add: 'self halt. ' + self code: 'self halt. ' ! codeHaltIfShiftPressed arguments debug ifTrue: [ ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[ - self add: 'Halt ifShiftPressed.' + self code: 'Halt ifShiftPressed.' ] ] "Modified: / 10-05-2015 / 07:39:47 / Jan Vrany " ! -codeIf: condition then: then - self codeIf: condition then: then else: nil +codeProfileStart + self code: 'context methodInvoked: #', clazz currentMethod methodName, '.' + + "Created: / 01-06-2015 / 21:17:19 / Jan Vrany " +! - "Created: / 16-06-2015 / 06:07:06 / Jan Vrany " +codeProfileStop + self code: 'context methodFinished: #', clazz currentMethod methodName, '.' + + "Created: / 01-06-2015 / 21:19:11 / Jan Vrany " +! + +codeTranscriptShow: text + (arguments profile) ifTrue: [ + self code: 'Transcript show: ', text storeString, '; cr.'. + ] ! -codeIf: condition then: then else: else - currentMethod - add: '('; - codeOnLine: condition; - addOnLine: ')'. - then notNil ifTrue:[ - currentMethod - addOnLine:' ifTrue: '; - codeBlock: then. - ]. - else notNil ifTrue:[ - currentMethod - addOnLine:' ifFalse: '; - codeBlock: else. - ]. - self codeDot. +profileTokenRead: tokenName + arguments profile ifTrue: [ + self code: 'context tokenRead: ', tokenName storeString, '.' + ] +! ! + +!PPCCodeGen methodsFor:'code error handling'! - "Created: / 01-06-2015 / 22:43:15 / Jan Vrany " - "Modified: / 16-06-2015 / 06:09:33 / Jan Vrany " +codeClearError + self code: 'error := false.'. +! + +codeError + self code: 'self error: ''message notspecified''.'. +! + +codeError: errorMessage + self code: 'self error: ''', errorMessage, '''.' +! + +codeError: errorMessage at: position + self code: 'self error: ''', errorMessage, ''' at: ', position asString, '.' ! codeIfErrorThen: then @@ -300,343 +325,156 @@ ^ self codeIf: 'error' then: then else: else "Created: / 16-06-2015 / 06:05:56 / Jan Vrany " +! ! + +!PPCCodeGen methodsFor:'code primitives'! + +add: string + self error: 'deprecated?'. + clazz currentMethod add: string. ! -codeNextToken - self add: 'self nextToken.' - - "Created: / 23-04-2015 / 18:01:05 / Jan Vrany " - "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany " -! - -codeOnLIne:aStringOrBlockOrRBParseNode - currentMethod codeOnLine: aStringOrBlockOrRBParseNode - - "Created: / 01-06-2015 / 23:49:11 / Jan Vrany " +addConstant: value as: name + clazz addConstant: value as: name ! -codeParsedValueOf: aBlock - | tmpVarirable method | - - self assert: aBlock isBlock. - tmpVarirable := returnVariable. - returnVariable := #whatever. - method := [ - aBlock value - ] ensure:[ returnVariable := tmpVarirable ]. - self assert: returnVariable == tmpVarirable. - self assert: (method isKindOf: PPCMethod). - - self codeCall: method. +addOnLine: string + self error: 'deprecated'. + clazz currentMethod addOnLine: string. ! -codeProfileStart - self add: 'context methodInvoked: #', currentMethod methodName, '.' +addVariable: name + ^ clazz currentNonInlineMethod addVariable: name - "Created: / 01-06-2015 / 21:17:19 / Jan Vrany " -! - -codeProfileStop - self add: 'context methodFinished: #', currentMethod methodName, '.' - - "Created: / 01-06-2015 / 21:19:11 / Jan Vrany " + "Modified: / 23-04-2015 / 17:34:02 / Jan Vrany " ! -codeReturn - currentMethod isInline ifTrue: [ - "If inlined, the return variable already holds the value" - ] ifFalse: [ - arguments profile ifTrue:[ - self codeProfileStop. - ]. - self add: '^ ', currentMethod returnVariable - ]. +call: anotherMethod + self error: 'deprecated?'. + clazz currentMethod add: anotherMethod call. +! - "Created: / 23-04-2015 / 18:01:05 / Jan Vrany " - "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany " +callOnLine: anotherMethod + self error: 'deprecated?'. + clazz currentMethod addOnLine: anotherMethod call. ! -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 " - "Modified: / 01-06-2015 / 21:48:51 / Jan Vrany " +dedent + clazz currentMethod dedent ! -codeReturnParsedValueOf: aBlock - | tmpVarirable method | +indent + clazz currentMethod indent +! ! - self assert:aBlock isBlock. - tmpVarirable := returnVariable. - method := aBlock value. - self assert: returnVariable == tmpVarirable. - self assert: (method isKindOf: PPCMethod). - method isInline ifTrue:[ - self callOnLine:method. - self codeReturn: returnVariable. - ] ifFalse:[ - self codeReturn: method call. - - ] +!PPCCodeGen methodsFor:'code structures'! - "Created: / 23-04-2015 / 18:21:51 / Jan Vrany " +codeIf: condition then: then + self codeIf: condition then: then else: nil + + "Created: / 16-06-2015 / 06:07:06 / Jan Vrany " ! -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 +codeIf: condition then: then else: else + self + code: '('; + codeOnLine: condition; + codeOnLine: ')'. + then notNil ifTrue:[ + self + codeOnLine:' ifTrue: '; + codeBlock: then. ]. - - method isInline ifTrue: [ - self callOnLine: method - ] ifFalse: [ - self codeEvaluateAndAssign: (method call) to: aString. - ] - - "Created: / 23-04-2015 / 18:21:51 / Jan Vrany " -! + else notNil ifTrue:[ + self + codeOnLine:' ifFalse: '; + codeBlock: else. + ]. + self codeDot. -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.'. - ] + "Created: / 01-06-2015 / 22:43:15 / Jan Vrany " + "Modified: / 16-06-2015 / 06:09:33 / Jan Vrany " ! ! !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 " -! - idFor: anObject - ^ idGen idFor: anObject + ^ clazz idFor: anObject ! idFor: anObject defaultName: defaultName - ^ idGen idFor: anObject defaultName: defaultName -! - -idFor: object prefixed: prefix - ^ self idFor: object prefixed: prefix suffixed: '' -! - -idFor: object prefixed: prefix suffixed: suffix - self error: 'Should no longer be used'. - " - | 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 - ] - ] - " - - "Modified: / 17-08-2015 / 12:00:28 / Jan Vrany " -! - -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 + ^ clazz idFor: anObject defaultName: defaultName ! numberIdFor: object - ^ idGen numericIdFor: object + ^ clazz numberIdFor: object ! ! !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. - idGen := PPCIdGenerator new. -! ! - -!PPCCodeGen methodsFor:'profiling'! - -profileTokenRead: tokenName - arguments profile ifTrue: [ - self add: 'context tokenRead: ', tokenName storeString, '.' - ] + clazz := PPCClass new. ! ! !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 -! +startInline + ^ clazz startInline -checkCache: id - | method | - self flag: '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 " -! - -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 " + "Modified: / 01-06-2015 / 21:48:35 / Jan Vrany " ! 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. + ^ clazz startInline: id "Modified: / 01-06-2015 / 21:48:35 / Jan Vrany " ! startMethod: id - (methodCache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ]. - - currentMethod := PPCMethod new. - currentMethod id: id. - currentMethod category: self methodCategory. + clazz startMethod: id category: self methodCategory. arguments profile ifTrue:[ self codeProfileStart. ]. - self push. - - self cache: id as: currentMethod. - - "Modified: / 01-06-2015 / 21:19:41 / Jan Vrany " ! stopInline - ^ self pop. + ^ clazz stopInline "Modified: / 01-06-2015 / 21:37:59 / Jan Vrany " ! stopMethod - self cache: currentMethod methodName as: currentMethod. - "arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ]." - ^ self pop. + ^ clazz stopInline "Modified: / 01-06-2015 / 21:38:05 / Jan Vrany " -! - -top - ^ compilerStack top ! ! !PPCCodeGen methodsFor:'variables'! allocateReturnVariable - ^ self allocateReturnVariableNamed: 'retval' + ^ clazz allocateReturnVariableNamed: 'retval' "Created: / 23-04-2015 / 18:03:40 / Jan Vrany " "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany " ! 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 " + ^ clazz allocateReturnVariableNamed: name ! allocateTemporaryVariableNamed: preferredName "Allocate a new variable with (preferably) given name. Returns a real variable name that should be used." - ^ self currentNonInlineMethod allocateTemporaryVariableNamed: preferredName + ^ clazz allocateTemporaryVariableNamed: preferredName "Created: / 23-04-2015 / 17:33:31 / Jan Vrany " +! + +currentReturnVariable + ^ clazz currentReturnVariable ! !