src/core/debugger.slate

   1 "DebugConsole writeStream collectionLimit := 512.
   2 DebugConsole writeStream nestingLimit := 3.
   3 Stream PrettyPrinter collectionLimit := 512.
   4 Stream PrettyPrinter nestingLimit := 3."
   5
   6 Stream PrettyPrinter collectionLimit := 256.
   7 Stream PrettyPrinter nestingLimit := 2.
   8
   9 conditions define: #Debugger &parents: {Cloneable}
  10   &slots: {#condition -> Nil.
  11            #restarts -> ExtensibleArray new.
  12            #interpreter -> bootstrapInterpreter.
  13            #resource -> DebugConsole.
  14            #parser -> Parser.
  15            #printer -> DebugConsole writer.
  16            #namespace -> Nil.
  17            #frames -> ExtensibleArray new.
  18            #currentFrame -> Nil.
  19            #baseFramePointer -> Nil.
  20            #maxBacktraceSize -> 40.
  21            #basePrompt -> '> '.
  22            #isSaved -> False. "is the stack live or is it saved?"
  23            #quitFlag -> False}.
  24
  25 Debugger traits define: #Namespace &parents: {Namespace} &slots: {}.
  26
  27 ns@(Debugger Namespace traits) new [Debugger Namespace clone].
  28
  29 d@(Debugger traits) refreshWorkspace
  30 [
  31   d namespace := d namespace newSisterSpace.
  32   ns@(d namespace) debugger [d].
  33 ].
  34
  35 Debugger atSlotNamed: #namespace put: (Debugger Namespace newDelegatingTo: lobby).
  36
  37 d@(Debugger traits) on: resource
  38 [
  39   d resource := resource.
  40   d parser := d parser newOn: resource reader.
  41   d printer := resource writer.
  42   d printer collectionLimit := Stream PrettyPrinter collectionLimit.
  43   d printer nestingLimit := Stream PrettyPrinter nestingLimit.
  44   d
  45 ].
  46
  47 d@(Debugger traits) newFor: c &interpreter: interp &console: resource &topMethod: symbol &save: isSaved
  48 [
  49   interp `defaultsTo: d interpreter.
  50   resource `defaultsTo: d resource.
  51   isSaved `defaultsTo: False.
  52   symbol `defaultsTo: #invokeDebugger.
  53   d clone `>>
  54     [| :newD |
  55      on: resource.
  56      isSaved := isSaved.
  57      condition := c.
  58      restarts := d restarts new.
  59      namespace := d namespace clone.
  60      parser currentScope := nodes Namespace for: newD namespace.
  61      parser parseInteractively:
  62        ([repl parser parseInteractively]
  63          on: SeriousCondition do: #(return: False) `er).
  64      baseFramePointer := d interpreter framePointerOf: symbol.
  65      buildFrames. ]
  66 ].
  67
  68 c@(Condition traits) invokeDebugger
  69 "The hook for any Condition to start the debugger and enter its loop."
  70 [(Debugger newFor: c) enter].
  71
  72 d@(Debugger traits) findRestarts
  73 "Rebuilds the list of applicable restarts."
  74 [
  75   d restarts clear.
  76   conditionStack
  77     reverseDo:
  78       [| :context |
  79        (context is: Restart) /\ [context appliesTo: d condition]
  80          ifTrue: [d restarts addLast: context]].
  81   d restarts
  82 ].
  83
  84 d@(Debugger traits) describeRestartAt: index
  85 [
  86   restart ::= d restarts at: index.
  87   d printer `cache ; 'restart: ' ; index printString ; '\t'.
  88   restart describeOn: d printer.
  89 ].
  90
  91 d@(Debugger traits) describeRestarts
  92 "Describes the restarts available in the context, if any."
  93 [
  94   d printer `cache ; 'The following condition was signaled:\n'.
  95   d condition describeOn: d printer.
  96   d printer ; '\nAvailable Restarts:\n'.
  97   d restarts isEmpty
  98     ifTrue: [d printer ; '(none available)']
  99     ifFalse: [d restarts keysDo: #(d describeRestartAt: _) `er].
 100 ].
 101
 102 d@(Debugger traits) stackAt: x
 103 [
 104   d interpreter stack at: x
 105 ].
 106
 107 d@(Debugger traits) stackAt: x put: val
 108 [
 109   d interpreter stack at: x put: val
 110 ].
 111
 112 Debugger traits define: #Frame &parents: {Cloneable}
 113   &slots: #{#debugger. #framePointer. #nextFramePointer}.
 114
 115 Debugger traits define: #SavedFrame &parents: {Debugger Frame}
 116   &slots: #{#lexicalContext. #method. #instructionPointer. #resultStackLocation}.
 117
 118 f@(Debugger Frame traits) isSaved [False].
 119 f@(Debugger SavedFrame traits) isSaved [True].
 120
 121 f@(Debugger Frame traits) sizeOnStack [6].
 122
 123 f@(Debugger Frame traits) newOn: d@(Debugger traits) at: fp from: nextFp
 124 [
 125   fp > f sizeOnStack ifTrue:
 126     [f cloneSettingSlots: #{#debugger. #framePointer. #nextFramePointer} to: {d. fp. nextFp}]
 127 ].
 128
 129 f@(Debugger Frame traits) newAtTopOf: d@(Debugger traits)
 130 [
 131   f cloneSettingSlots: #{#debugger. #framePointer} to: {d. d baseFramePointer}
 132 ].
 133
 134 f@(Debugger Frame traits) nextFrame
 135 [
 136   f newOn: f debugger at: f callerFrameIndex from: f framePointer
 137 ].
 138
 139 f@(Debugger Frame traits) stackAtOffset: offset
 140 [f debugger stackAt: f framePointer + offset].
 141
 142 f@(Debugger Frame traits) stackAtOffset: offset put: value
 143 [f debugger stackAt: f framePointer + offset put: value].
 144
 145 f@(Debugger Frame traits) localForOffset: offset
 146 [
 147   f method method sourceTree
 148     ifNotNilDo:
 149       [| :src |
 150        (offset < src inputVariables size
 151           ifTrue: [src inputVariables]
 152           ifFalse: [src localVariables]) at: offset ifAbsent: [Nil]]
 153 ].
 154
 155 f@(Debugger Frame traits) stackOffsetForLocal: name
 156 [
 157   f method method sourceTree
 158     ifNil: [warn: 'No source information available for the current frame.'. ]
 159     ifNotNilDo:
 160       [| :src |
 161        (src inputVariables indexOfFirstSatisfying: [| :var | var name =~ name])
 162          ifNil:
 163            [src localVariables indexOfFirstSatisfying: [| :var | var name =~ name]]]
 164 ].
 165
 166 f@(Debugger Frame traits) callerFrameIndex
 167 [f stackAtOffset: -1].
 168
 169 f@(Debugger Frame traits) lexicalContext
 170 [f stackAtOffset: -2].
 171
 172 f@(Debugger Frame traits) method
 173 [f stackAtOffset: -3].
 174
 175 f@(Debugger Frame traits) callerInstructionPointer
 176 [f stackAtOffset: -4].
 177
 178 f@(Debugger Frame traits) instructionPointer
 179 [f debugger stackAt: f nextFramePointer - 4].
 180
 181 f@(Debugger Frame traits) resultStackLocation
 182 [f stackAtOffset: -5].
 183
 184 f@(Debugger Frame traits) previousStackPointer
 185 [f stackAtOffset: -6].
 186
 187 f@(Debugger Frame traits) callerFrameIndex: fp
 188 [f stackAtOffset: -1 put: fp].
 189
 190 f@(Debugger Frame traits) lexicalContext: lc
 191 [f stackAtOffset: -2 put: lc].
 192
 193 f@(Debugger Frame traits) method: m
 194 [f stackAtOffset: -3 put: m].
 195
 196 f@(Debugger Frame traits) callerInstructionPointer: ip
 197 [f stackAtOffset: -4 put: ip].
 198
 199 f@(Debugger Frame traits) instructionPointer: ip
 200 [f debugger stackAt: f nextFramePointer - 4 put: ip].
 201
 202 f@(Debugger Frame traits) resultStackLocation: rp
 203 [f stackAtOffset: -5 put: rp].
 204
 205 f@(Debugger Frame traits) previousStackPointer: sp
 206 [f stackAtOffset: -6 put: sp].
 207
 208 d@(Debugger traits) saveFrame: f@(Debugger Frame traits)
 209 [Debugger SavedFrame cloneSettingSlots: #{#lexicalContext. #method. #instructionPointer. #resultStackLocation. #debugger}
 210                      to: {f lexicalContext. f method. f instructionPointer. f resultStackLocation. d}].
 211
 212 f@(Debugger Frame traits) describeOn: out
 213 [
 214   method ::= f method method.
 215   out
 216     ; 'frame: ' ; (f debugger frames indexOf: f) printString ; '\n'
 217     ; '  FP: ' ; f framePointer printString  ; '\n'
 218     ; '  IP: ' ; f instructionPointer printString ; '\n'
 219     ; 'method: ' ; method printString ; ' @ ' ; method definitionLocation ; '\n'
 220     ; '  #calls: ' ; method callCount printString ; '\n'
 221     ; '  #registers: ' ; method registerCount printString ; '\n'
 222     ; '  code size: ' ; method code size printString ; '\n'
 223     ; '  source: ' ; method sourceTree printString ; '\n'.
 224   out ; 'Inputs:\n'.
 225   0 below: method inputVariables do:
 226     [| :i | out
 227        ; ' arg: ' ; i printString
 228        ; '\t' ; ((f localForOffset: i) ifNil: ['?'] ifNotNilDo: [| :var | var name as: ''])
 229        ; ' := ' ; (f isSaved ifTrue: ['(not live)'] ifFalse: [(f stackAtOffset: i) printString])
 230        ; '\n'].
 231   out ; 'Locals:\n'.
 232   method inputVariables below: method inputVariables + method localVariables do:
 233     [| :i | out
 234        ; ' arg: ' ; i printString
 235        ; '\t' ; ((f localForOffset: i) ifNil: ['?'] ifNotNilDo: [| :var | var name as: ''])
 236        ; ' := ' ; (f isSaved ifTrue: ['(not live)'] ifFalse: [(f stackAtOffset: i) printString])
 237        ; '\n'].
 238   out ; 'Registers:\n'.
 239   method inputVariables + method localVariables below: method registerCount do:
 240     [| :i | out
 241        ; ' arg: ' ; i printString
 242        ; '\t' ; (f isSaved ifTrue: ['(not live)'] ifFalse: [(f stackAtOffset: i) printString])
 243        ; '\n'].
 244   out ; 'Decompiled:\n'.
 245   [method printInstructionsOn: out &condensed: True]
 246     on: SeriousCondition do: [| :c | out ; '(instructions unavailable)\n'. c return: Nil].
 247 ].
 248
 249 f@(Debugger Frame traits) reset
 250 [
 251   f instructionPointer := 0.
 252 ].
 253
 254 f@(Debugger Frame traits) restart
 255 "Proceed execution from the start of this frame."
 256 [
 257   f reset.
 258   f debugger quitFlag := True.
 259 ].
 260
 261 d@(Debugger traits) topFrame
 262 [d Frame newAtTopOf: d].
 263
 264 d@(Debugger traits) buildFrames
 265 [| frame |
 266   d baseFramePointer ifNil:
 267     [error: 'Base frame pointer is nil. Cannot build stack frames.\n'. ^ Nil].
 268   d frames := d frames new `>> [add: (frame := d topFrame). ].
 269   [(frame := frame nextFrame) isNotNil] whileTrue:
 270     [d frames add:
 271        (d isSaved
 272           ifTrue: [d saveFrame: frame]
 273           ifFalse: [frame])].
 274 ].
 275
 276 d@(Debugger traits) prompt
 277 [
 278   [| :out |
 279    out ; 'slate-debug'.
 280    d restarts isEmpty
 281      ifFalse: [out ; '[0'.
 282               d restarts size > 1 ifTrue:
 283                 [out ; '..' ; d restarts indexLast printString].
 284               out ; ']'].
 285    d currentFrame ifNotNilDo: [| :frame | out ; '[frame: ' ; ((d frames indexOf: frame) as: String) ; ']'].
 286    out ; d basePrompt] writingAs: ''
 287 ].
 288
 289 d@(Debugger traits) signalRestartAt: index
 290 "Takes the restart option number from the queryRestart and invokes it."
 291 [
 292   (d restarts acceptsKey: index)
 293     ifTrue: [((d restarts at: index) newCondition: d condition)
 294               `>> [queryFrom: d. signal]]
 295     ifFalse: [d resource ; index printString ; ' is not a valid restart.\n']
 296 ].
 297
 298 d@(Debugger traits) printFrameLineAt: index &stream: out &showLocation: showLocation
 299 [
 300   out `defaultsTo: d printer.
 301   showLocation `defaultsTo: False.
 302   frame ::= d frames at: index.
 303   out ; 'frame: ' ; index printString ; (d currentFrame = frame ifTrue: [' *'] ifFalse: ['']) ; '\t' ; frame method printString.
 304   showLocation ifTrue: [out ; ' @ ' ; frame method method definitionLocation].
 305   out ; '\n'.
 306 ].
 307
 308 d@(Debugger traits) printBacktrace &fromFrame: frameIndex &limit: limit &stream: out &showLocation: showLocation
 309 [
 310   limit `defaultsTo: d maxBacktraceSize.
 311   frameIndex `defaultsTo: ((d frames identityIndexOf: d currentFrame) - (limit // 2) max: 0).
 312   out `defaultsTo: d printer.
 313   showLocation `defaultsTo: True.
 314   out ; 'Backtrace (method @ source): \n'.
 315   frameIndex below: (d frames length min: frameIndex + limit) do:
 316     [| :index | d printFrameLineAt: index &showLocation: showLocation].
 317 ].
 318
 319 d@(Debugger traits) frame: index
 320 "Selects the frame at the given index."
 321 [
 322   d currentFrame := d frames at: index ifAbsent: [Nil]
 323 ].
 324
 325 d@(Debugger traits) top
 326 [
 327   d currentFrame := d frames first
 328 ].
 329
 330 d@(Debugger traits) bottom
 331 [
 332   d currentFrame := d frames last
 333 ].
 334
 335 d@(Debugger traits) up
 336 [
 337   (d frames before: d currentFrame)
 338     ifNil: [error: 'You are at the top of the stack and cannot go up a frame']
 339     ifNotNilDo: [| :frame | d currentFrame := frame]
 340 ].
 341
 342 d@(Debugger traits) down
 343 [
 344   (d frames after: d currentFrame)
 345     ifNil: [error: 'You are at the bottom of the stack and cannot go down a frame']
 346     ifNotNilDo: [| :frame | d currentFrame := frame]
 347 ].
 348
 349 d@(Debugger traits) currentFrameAt: n@(Integer traits)
 350 [
 351   d currentFrame isSaved ifTrue: [error: 'Cannot get value in saved frame'].
 352   d currentFrame
 353     ifNil: [^ (d printer ; 'No frame currently selected. Use "frame: N"')]
 354     ifNotNilDo:
 355       [| :frame |
 356        method ::= frame method method.
 357        d printer ; 'register[' ; n printString ; ']@' ; (frame stackAtOffset: n) printName
 358         ; '\t' ; (frame stackAtOffset: n) printString ; '\n'.
 359        frame stackAtOffset: n]
 360 ].
 361
 362 d@(Debugger traits) currentFrameAt: n@(Integer traits) put: val
 363 [
 364   d currentFrame isSaved ifTrue: [error: 'Cannot set value in saved frame'].
 365   d currentFrame stackAtOffset: n put: val
 366 ].
 367
 368 d@(Debugger traits) currentFrameAt: name
 369 [
 370   (d currentFrame stackOffsetForLocal: name)
 371     ifNil: [error: 'Input or Local Variable not found']
 372     ifNotNilDo: #(d currentFrameAt: _) `er
 373 ].
 374
 375 d@(Debugger traits) currentFrameAt: name put: val
 376 [
 377   (d currentFrame stackOffsetForLocal: name)
 378     ifNil: [error: 'Input or Local Variable not found']
 379     ifNotNilDo: #(d currentFrameAt: _ put: val) `er
 380 ].
 381
 382 d@(Debugger traits) printFrame
 383 [
 384   d currentFrame
 385     ifNil: [^ (d printer ; 'No frame currently selected. Use "frame: N"')]
 386     ifNotNilDo: [| :frame | frame describeOn: d printer]
 387 ].
 388
 389 ns@(Debugger Namespace traits) frame
 390 [ns debugger printFrame].
 391 ns@(Debugger Namespace traits) True
 392 [True].
 393 ns@(Debugger Namespace traits) False
 394 [False].
 395 ns@(Debugger Namespace traits) frame
 396 [ns debugger currentFrame].
 397 ns@(Debugger Namespace traits) frame: n
 398 [ns debugger `>> [frame := n. printFrame]].
 399 ns@(Debugger Namespace traits) top
 400 [ns debugger `>> [top. printFrame]].
 401 ns@(Debugger Namespace traits) up
 402 [ns debugger `>> [up. printFrame]].
 403 ns@(Debugger Namespace traits) down
 404 [ns debugger `>> [down. printFrame]].
 405 ns@(Debugger Namespace traits) arg: n
 406 [ns debugger currentFrameAt: n].
 407 ns@(Debugger Namespace traits) arg: n put: newVal
 408 [ns debugger currentFrameAt: n put: newVal].
 409 ns@(Debugger Namespace traits) frames &fromFrame: frameIndex &limit: n &showLocation: showLocation
 410 [ns debugger printBacktrace &fromFrame: frameIndex &limit: n &showLocation: showLocation].
 411 ns@(Debugger Namespace traits) backtrace &fromFrame: frameIndex &limit: n &showLocation: showLocation
 412 [ns debugger printBacktrace &fromFrame: frameIndex &limit: n &showLocation: showLocation].
 413 ns@(Debugger Namespace traits) bt &fromFrame: frameIndex &limit: n &showLocation: showLocation
 414 [ns debugger printBacktrace &fromFrame: frameIndex &limit: n &showLocation: showLocation].
 415 ns@(Debugger Namespace traits) restarts
 416 [ns debugger describeRestarts].
 417 ns@(Debugger Namespace traits) restart: index
 418 [ns debugger signalRestartAt: index].
 419 ns@(Debugger Namespace traits) : index
 420 [ns debugger signalRestartAt: index].
 421 ns@(Debugger Namespace traits) quit
 422 [ns debugger quitFlag := True].
 423 ns@(Debugger Namespace traits) return: value
 424 [ns debugger return: value].
 425
 426 ns@(Debugger Namespace traits) help
 427 [
 428   ns debugger printer
 429    ; 'The Debugger is a specialized REPL that evaluates expressions within the method currently being debugged. Certain messages are provided for changing the state of the debugger, as follows:\n'
 430    ; ': index. (or restart: index.)\n\tSignal the restart at the given index\n'
 431    ; 'backtrace (or "bt")\n\tPrint the backtrace\n'
 432    ; 'frame\n\tPrint the current frame\n'
 433    ; 'frame: N\n\tSet the current frame\n'
 434    ; 'frame restart\n\tResume execution from the start of the current frame\n'
 435    ; 'down\n\tMove down one frame (to the caller)\n'
 436    ; 'up\n\tMove up one frame (in the callee direction)\n'
 437    ; 'arg: N\n\tDisplays the frame\'s register at index N\n'
 438    ; 'arg: N put:\n\tSets the frame\'s register at index N\n'
 439    ; 'restarts\n\tPrint the currently available restarts\n'
 440    ; 'help\n\tPrint this help listing\n'.
 441 ].
 442
 443 ns@(Debugger Namespace traits) ? [ns help].
 444
 445 ns@(Debugger Namespace traits) ? obj [ns helpFor: obj].
 446
 447 ns@(Debugger Namespace traits) didNotUnderstand: message at: position
 448 [
 449   position > 0
 450    ifTrue: [resend]
 451    ifFalse:
 452      [selector ::= message selector.
 453       "Handle an accessor."
 454       selector isUnarySelector
 455         ifTrue: [^ [ns arg: selector]].
 456       "Handle a mutator."
 457       selector isKeywordSelector /\ [selector arity = 2]
 458         ifTrue: [^ [ns arg: selector keywords first put: message arguments second]].
 459       resend]
 460 ].
 461
 462 d@(Debugger traits) enter
 463 "The main interactive debugger loop."
 464 [
 465   d printer `cache ; 'Debugging: ' ; d condition printName ; '\n'.
 466   d refreshWorkspace.
 467   d findRestarts.
 468   d top.
 469   "d printer ; d frames printString."
 470   "d printBacktrace."
 471   d describeRestarts.
 472   d printer ; '\nEnter \'help.\' for instructions.\n'.
 473   [
 474   "Print out the restarting options with a prompt and numeric labels, and read
 475 in the selected option number, returning it if valid."
 476   d printer ; d prompt.
 477   d printer flush.
 478   [| expr result restartNumeric |
 479    [expr := d parser next] on: Stream Exhaustion do:
 480      [| :c | c stream == d resource reader ifTrue: [lobby exit: 1]].
 481    result := expr evaluateIn: d namespace.
 482    restartNumeric := (expr is: nodes Literal) /\ [result is: Integer].
 483    "Exclude selections of restarts and other commands from printing."
 484    restartNumeric \/
 485      [(expr is: nodes Message)
 486         /\ [#{#:. #restart:. #frame. #frame:. #restarts. #help. #bt. #backtrace} includes: expr selector]]
 487       ifFalse:
 488         [[result printOn: d printer]
 489            on: Error do: [| :c | d printer ; '<Printing failed>'].
 490          d printer newLine.
 491          d printer flush].
 492    restartNumeric ifTrue: [d signalRestartAt: result].
 493    ] on: SeriousCondition
 494     do: [| :c |
 495       d printer ; '\nThe following condition was signaled from within the debugger:\n'.
 496       c describeOn: d printer.
 497       (c is: Stream Exhaustion) /\ [c stream resource handle = 0]
 498         ifTrue: [d printer ; 'End of input, exiting...\n'. lobby exit: 1].
 499       c exit].
 500   d quitFlag] whileFalse.
 501 ].