--- a/ReadEvalPrintLoop.st Thu Nov 03 22:51:16 2016 +0100
+++ b/ReadEvalPrintLoop.st Thu Nov 03 23:00:20 2016 +0100
@@ -15,8 +15,8 @@
Object subclass:#ReadEvalPrintLoop
instanceVariableNames:'inputStream outputStream errorStream compiler prompt
- doChunkFormat traceFlag timingFlag printFlag exitAction
- currentDirectory'
+ doChunkFormat traceFlag timingFlag profilingFlag printFlag
+ exitAction currentDirectory'
classVariableNames:''
poolDictionaries:''
category:'System-Support'
@@ -196,7 +196,7 @@
cmd_help:lineStream
self errorStream
- nextPutAll:
+ nextPutAll:
'Everything entered up to an empty line or a line ending in "." is called a "chunk" and evaluated.
Lines starting with "#" are commands to the read-eval-print interpreter.
@@ -204,21 +204,22 @@
#help ............... this text
#exit ............... exit interpreter loop
#use <package>....... use (load) a package
- stx:libwidg .............. GUI package
- stx:libtool .............. IDE tool package
- stx:goodies/regex ........ regex package
- stx:goodies/petitparser .. peg parser package
+ stx:libwidg .............. GUI package
+ stx:libtool .............. IDE tool package
+ stx:goodies/regex ........ regex package
+ stx:goodies/petitparser .. peg parser package
#read <filename>..... read another script or source file
#show <what> ........ show info
- variables .......... interpreter variables
- processes .......... processes
- memory ............. memory usage
- flags .............. flags
- modules ............ loaded modules
+ variables .......... interpreter variables
+ processes .......... processes
+ memory ............. memory usage
+ flags .............. flags
+ modules ............ loaded modules
#set/clear <flag> ... set or clear a flag
- trace .............. tracing execution
- timing ............. timing execution
- chunkFormat ........ traditional bang chunk format input mode
+ trace .............. tracing execution
+ timing ............. timing execution
+ profiling .......... show execution profile
+ chunkFormat ........ traditional bang chunk format input mode
The MiniDebugger (if entered) shows its own help with "?".
'
@@ -288,18 +289,22 @@
lineStream skipSeparators.
what := lineStream nextAlphaNumericWord.
what notNil ifTrue:[
- (what startsWith:'tra') ifTrue:[
- traceFlag := aBoolean.
- ^ self.
- ].
- (what startsWith:'tim') ifTrue:[
- timingFlag := aBoolean.
- ^ self.
- ].
- (what startsWith:'chunk') ifTrue:[
- doChunkFormat := aBoolean.
- ^ self.
- ].
+ (what startsWith:'tra') ifTrue:[
+ traceFlag := aBoolean.
+ ^ self.
+ ].
+ (what startsWith:'tim') ifTrue:[
+ timingFlag := aBoolean.
+ ^ self.
+ ].
+ (what startsWith:'pro') ifTrue:[
+ profilingFlag := aBoolean.
+ ^ self.
+ ].
+ (what startsWith:'chunk') ifTrue:[
+ doChunkFormat := aBoolean.
+ ^ self.
+ ].
].
self errorStream nextPutLine:'? which flag ?'.
@@ -509,28 +514,37 @@
] do:[
|value ms us|
- us := Time microsecondsToRun:[
- value := (compilerClass new
- requestor:self)
- evaluate:chunk
- compile:true.
- ].
- doPrint ifTrue:[
- value printOn:output. output cr.
- ].
+ profilingFlag == true ifTrue:[
+ MessageTally spyDetailedOn:[
+ value := (compilerClass new requestor:self)
+ evaluate:chunk
+ compile:true.
+ ].
+ doPrint ifTrue:[
+ value printOn:output. output cr.
+ ].
+ ] ifFalse:[
+ us := Time microsecondsToRun:[
+ value := (compilerClass new requestor:self)
+ evaluate:chunk compile:true.
+ ].
+ doPrint ifTrue:[
+ value printOn:output. output cr.
+ ].
- timingFlag == true ifTrue:[
- 'execution time: ' printOn:error.
- us < 1000 ifTrue:[
- us < 1 ifTrue:[
- 'too small to measure (<1us)' printOn:error.
+ timingFlag == true ifTrue:[
+ 'execution time: ' printOn:error.
+ us < 1000 ifTrue:[
+ us < 1 ifTrue:[
+ 'too small to measure (<1us)' printOn:error.
+ ] ifFalse:[
+ us printOn:output. 'us' printOn:error.
+ ]
] ifFalse:[
- us printOn:output. 'us' printOn:error.
- ]
- ] ifFalse:[
- ((us / 1000) asFixedPoint:2) printOn:output. 'ms' printOn:error.
+ ((us / 1000) asFixedPoint:2) printOn:output. 'ms' printOn:error.
+ ].
+ error cr.
].
- error cr.
].
Workspace notNil ifTrue:[
Workspace rememberResultAsWorkspaceVariable:value.