compiler/benchmarks/PPCBenchmark.st
changeset 537 fb212e14d1f4
parent 529 439c4057517f
child 538 16e8536f5cfb
equal deleted inserted replaced
536:548996aca274 537:fb212e14d1f4
     2 
     2 
     3 "{ NameSpace: Smalltalk }"
     3 "{ NameSpace: Smalltalk }"
     4 
     4 
     5 Object subclass:#PPCBenchmark
     5 Object subclass:#PPCBenchmark
     6 	instanceVariableNames:'sources report contextClass compile parser context input
     6 	instanceVariableNames:'sources report contextClass compile parser context input
     7 		configuration profile repetitions'
     7 		compiler profile repetitions'
     8 	classVariableNames:''
     8 	classVariableNames:''
     9 	poolDictionaries:''
     9 	poolDictionaries:''
    10 	category:'PetitCompiler-Benchmarks-Core'
    10 	category:'PetitCompiler-Benchmarks-Core'
    11 !
    11 !
    12 
    12 
   320     self reportInput: input time: time name: 'Smalltalk Parser'.
   320     self reportInput: input time: time name: 'Smalltalk Parser'.
   321 !
   321 !
   322 
   322 
   323 benchmarkSmalltalkParserCompiled
   323 benchmarkSmalltalkParserCompiled
   324     | time |
   324     | time |
   325     
   325 
   326     configuration := PPCConfiguration default.
   326     compiler := PPCCompiler default.
   327     parser := PPSmalltalkParser new compileWithConfiguration: configuration.
   327     parser := PPSmalltalkParser new compileUsingCompiler:compiler.
   328     context := PPCContext new.
   328     context := PPCContext new.
   329     context initializeFor: parser.
   329     context initializeFor:parser.
   330     input := sources smalltalkSourcesBig.
   330     input := sources smalltalkSourcesBig.
   331 
   331     time := [
   332     time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
   332             input do:[:source | 
   333     
   333                 parser parse:source withContext:context
   334         self reportInput: input time: time name: 'Smalltalk Parser Compiled'.
   334             ]
       
   335         ] timeToRun 
       
   336             asMilliSeconds.
       
   337     self 
       
   338         reportInput:input
       
   339         time:time
       
   340         name:'Smalltalk Parser Compiled'.
   335 ! !
   341 ! !
   336 
   342 
   337 !PPCBenchmark methodsFor:'benchmarks-CalipeL'!
   343 !PPCBenchmark methodsFor:'benchmarks-CalipeL'!
   338 
   344 
   339 benchmarkExpressionGrammarC
   345 benchmarkExpressionGrammarC
   545     context initializeFor: parser.
   551     context initializeFor: parser.
   546     input := sources expressionSourcesMedium.
   552     input := sources expressionSourcesMedium.
   547 !
   553 !
   548 
   554 
   549 setupExpressionGrammarCompiled
   555 setupExpressionGrammarCompiled
   550     
   556     compiler := PPCCompiler universal.
   551     configuration := PPCConfiguration universal.
   557     compiler options parserName:#PPCompiledExpressionGrammar.
   552     configuration options parserName: #PPCompiledExpressionGrammar.
   558     compiler options scannerName:#PPCompiledExpressionScanner.
   553     configuration options scannerName: #PPCompiledExpressionScanner.
   559     parser := PPExpressionGrammar new compileUsingCompiler:compiler.
   554     parser := PPExpressionGrammar new compileWithConfiguration: configuration.
   560     context := self context.
   555     context := self context.
   561     context initializeFor:parser.
   556     context initializeFor: parser.
       
   557     input := sources expressionSourcesMedium.
   562     input := sources expressionSourcesMedium.
   558 !
   563 !
   559 
   564 
   560 setupExpressionGrammarTokenized
   565 setupExpressionGrammarTokenized
   561     
   566     compiler := PPCCompiler tokenizing.
   562     configuration := PPCConfiguration tokenizing.
   567     compiler options parserName:#PPTokenizedExpressionGrammar.
   563     configuration options parserName: #PPTokenizedExpressionGrammar.
   568     compiler options scannerName:#PPTokenizedExpressionScanner.
   564     configuration options scannerName: #PPTokenizedExpressionScanner.
   569     parser := PPExpressionGrammar new compileUsingCompiler:compiler.
   565     parser := PPExpressionGrammar new compileWithConfiguration: configuration.
   570     context := self context.
   566     context := self context.
   571     context initializeFor:parser.
   567     context initializeFor: parser.
       
   568     input := sources expressionSourcesMedium.
   572     input := sources expressionSourcesMedium.
   569 !
   573 !
   570 
   574 
   571 setupJavaSyntax
   575 setupJavaSyntax
   572     
   576     
   596     context initializeFor: parser.
   600     context initializeFor: parser.
   597     input := sources expressionSourcesBig.
   601     input := sources expressionSourcesBig.
   598 !
   602 !
   599 
   603 
   600 setupLL1ExpressionGrammarCompiled
   604 setupLL1ExpressionGrammarCompiled
   601     
   605     compiler := PPCCompiler universal.
   602     configuration := PPCConfiguration universal.
   606     compiler options parserName:#PPCompiledLL1ExpressionGrammar.
   603     configuration options parserName: #PPCompiledLL1ExpressionGrammar.
   607     compiler options scannerName:#PPCompiledLL1ExpressionScanner.
   604     configuration options scannerName: #PPCompiledLL1ExpressionScanner.
   608     parser := PPLL1ExpressionGrammar new compileUsingCompiler:compiler.
   605     parser := PPLL1ExpressionGrammar new compileWithConfiguration: configuration.
   609     context := self context.
   606     context := self context.
   610     context initializeFor:parser.
   607     context initializeFor: parser.
       
   608     input := sources expressionSourcesBig.
   611     input := sources expressionSourcesBig.
   609 !
   612 !
   610 
   613 
   611 setupLL1ExpressionGrammarTokenized
   614 setupLL1ExpressionGrammarTokenized
   612     
   615     compiler := PPCCompiler tokenizing.
   613     configuration := PPCConfiguration tokenizing.
   616     compiler options parserName:#PPTokenizedLL1ExpressionGrammar.
   614     configuration options parserName: #PPTokenizedLL1ExpressionGrammar.
   617     compiler options scannerName:#PPTokenizedLL1ExpressionScanner.
   615     configuration options scannerName: #PPTokenizedLL1ExpressionScanner.
   618     parser := PPLL1ExpressionGrammar new compileUsingCompiler:compiler.
   616     parser := PPLL1ExpressionGrammar new compileWithConfiguration: configuration.
   619     context := self context.
   617     context := self context.
   620     context initializeFor:parser.
   618     context initializeFor: parser.
       
   619     input := sources expressionSourcesBig.
   621     input := sources expressionSourcesBig.
   620 !
   622 !
   621 
   623 
   622 setupLRPParser
   624 setupLRPParser
   623     
   625     
   628 
   630 
   629     "Created: / 18-08-2015 / 16:34:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   631     "Created: / 18-08-2015 / 16:34:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   630 !
   632 !
   631 
   633 
   632 setupLRPParserCompiled
   634 setupLRPParserCompiled
   633 
   635     compiler := PPCCompiler universal.
   634     configuration := PPCConfiguration universal.
   636     parser := PPCLRPParser new compileUsingCompiler:compiler.
   635     parser := PPCLRPParser new compileWithConfiguration: configuration.
   637     context := self context.
   636     context := self context.
   638     context initializeFor:parser.
   637     context initializeFor: parser.
       
   638     input := PPCLRPSourcesResource current sources
   639     input := PPCLRPSourcesResource current sources
   639 
   640 
   640     "Created: / 18-08-2015 / 16:35:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   641     "Created: / 18-08-2015 / 16:35:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   641 !
   642 !
   642 
   643 
   662     context initializeFor: parser.
   663     context initializeFor: parser.
   663     input := sources smalltalkSourcesBig.
   664     input := sources smalltalkSourcesBig.
   664 !
   665 !
   665 
   666 
   666 setupSmalltalkGrammarCompiled
   667 setupSmalltalkGrammarCompiled
   667 
   668     compiler := PPCCompiler universal.
   668     configuration := PPCConfiguration universal.
   669     compiler options parserName:#'PPSmalltalkGrammarC_Unviersal'.
   669     configuration options parserName: #PPSmalltalkGrammarC_Unviersal.
   670     compiler options profile:profile.
   670     configuration options profile: profile.
   671     parser := PPSmalltalkGrammar new compileUsingCompiler:compiler.
   671     
   672     context := self context.
   672     parser := PPSmalltalkGrammar new compileWithConfiguration: configuration.
   673     context initializeFor:parser.
   673     context := self context.
   674     profile ifTrue:[
   674     context initializeFor: parser.
   675         input := sources smalltalkSourcesSmall.
   675     
   676     ] ifFalse:[
   676     profile ifTrue: [ 
   677         input := sources smalltalkSourcesBig.
   677         input := sources smalltalkSourcesSmall.	
       
   678     ] ifFalse: [ 
       
   679         input := sources smalltalkSourcesBig.	
       
   680     ]
   678     ]
   681 !
   679 !
   682 
   680 
   683 setupSmalltalkGrammarTokenized
   681 setupSmalltalkGrammarTokenized
   684 
   682     compiler := PPCCompiler tokenizing.
   685     configuration := PPCConfiguration tokenizing.
   683     compiler options parserName:#'PPSmalltalkGrammarC_Tokenizing'.
   686     configuration options parserName: #PPSmalltalkGrammarC_Tokenizing.
   684     compiler options scannerName:#'PPSmalltalkGrammarC_Scanner'.
   687     configuration options scannerName: #PPSmalltalkGrammarC_Scanner.
   685     compiler options profile:profile.
   688     configuration options profile: profile.
   686     parser := PPSmalltalkGrammar new compileUsingCompiler:compiler.
   689     
   687     context := self context.
   690     parser := PPSmalltalkGrammar new compileWithConfiguration: configuration.
   688     context initializeFor:parser.
   691     context := self context.
   689     profile ifTrue:[
   692     context initializeFor: parser.
   690         input := sources smalltalkSourcesSmall.
   693     profile ifTrue: [ 
   691     ] ifFalse:[
   694         input := sources smalltalkSourcesSmall.	
   692         input := sources smalltalkSourcesBig.
   695     ] ifFalse: [ 
       
   696         input := sources smalltalkSourcesBig.	
       
   697     ]
   693     ]
   698 !
   694 !
   699 
   695 
   700 setupSmalltalkNoopParserCompiled
   696 setupSmalltalkNoopParserCompiled
   701 
   697     compiler := PPCCompiler universal.
   702     configuration := PPCConfiguration universal.
   698     parser := PPCSmalltalkNoopParser new compileUsingCompiler:compiler.
   703     parser := PPCSmalltalkNoopParser new compileWithConfiguration: configuration.
       
   704     context := PPCContext new.
   699     context := PPCContext new.
   705     context initializeFor: parser.
   700     context initializeFor:parser.
   706     input := sources smalltalkSourcesBig.
   701     input := sources smalltalkSourcesBig.
   707 
   702 
   708     "Created: / 16-05-2015 / 09:44:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   703     "Created: / 16-05-2015 / 09:44:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   709 !
   704 !
   710 
   705 
   711 setupSmalltalkNoopParserTokenized
   706 setupSmalltalkNoopParserTokenized
   712 
   707     compiler := PPCCompiler tokenizing.
   713     configuration := PPCConfiguration tokenizing.
   708     parser := PPCSmalltalkNoopParser new compileUsingCompiler:compiler.
   714     parser := PPCSmalltalkNoopParser new compileWithConfiguration: configuration.
       
   715     context := PPCContext new.
   709     context := PPCContext new.
   716     context initializeFor: parser.
   710     context initializeFor:parser.
   717     input := sources smalltalkSourcesBig.
   711     input := sources smalltalkSourcesBig.
   718 
   712 
   719     "Created: / 16-05-2015 / 09:44:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   713     "Created: / 16-05-2015 / 09:44:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   720 !
   714 !
   721 
   715 
   726     context initializeFor: parser.
   720     context initializeFor: parser.
   727     input := sources smalltalkSourcesBig.
   721     input := sources smalltalkSourcesBig.
   728 !
   722 !
   729 
   723 
   730 setupSmalltalkParserCompiled
   724 setupSmalltalkParserCompiled
   731 
   725     compiler := PPCCompiler universal.
   732     configuration := PPCConfiguration universal.
   726     parser := PPSmalltalkParser new compileUsingCompiler:compiler.
   733     parser := PPSmalltalkParser new compileWithConfiguration: configuration.
   727     context := self context.
   734     context := self context.
   728     context initializeFor:parser.
   735     context initializeFor: parser.
       
   736     input := sources smalltalkSourcesBig.
   729     input := sources smalltalkSourcesBig.
   737 !
   730 !
   738 
   731 
   739 setupSmalltalkParserTokenized
   732 setupSmalltalkParserTokenized
   740 
   733     compiler := PPCCompiler tokenizing.
   741     configuration := PPCConfiguration tokenizing.
   734     parser := PPSmalltalkParser new compileUsingCompiler:compiler.
   742     parser := PPSmalltalkParser new compileWithConfiguration: configuration.
   735     context := self context.
   743     context := self context.
   736     context initializeFor:parser.
   744     context initializeFor: parser.
       
   745     input := sources smalltalkSourcesBig.
   737     input := sources smalltalkSourcesBig.
   746 !
   738 !
   747 
   739 
   748 teardownExpressionGrammarTokenized
   740 teardownExpressionGrammarTokenized
   749     parser class removeFromSystem.
   741     parser class removeFromSystem.