src/lib/devsupport.slate

   1
   2 "Support functions to help with development"
   3
   4 "#as: implementations do: [| :each | inform: each definitionLocation ]."
   5
   6 "(#parseExpression findOn: {Syntax Parser}) definitionLocation"
   7
   8 "'' allRoles."
   9
  10 x@(Root traits) allRoles
  11 [
  12   [| :result |
  13    x allDelegates do:
  14      [| :delegate |
  15       delegate roleReader >> [| :r | r selector -> r rolePositions] >> result]
  16   ] writingAs: ExtensibleArray
  17 ].
  18
  19 d@(Debugger traits) printCurrentStack &limit: limit &stream: out &showLocation: showLocation
  20 [
  21   d clone `>>
  22     [baseFramePointer := (d interpreter framePointerOf: #printCurrentStack).
  23      buildFrames.
  24      printBacktrace &limit: limit &stream: out &showLocation: showLocation ]
  25 ].
  26
  27 x@(Root traits) methodsUsingMe
  28 [
  29   [| :result |
  30    x allDelegates do:
  31      [| :delegate |
  32       delegate roleReader do:
  33         [| :role selector findOnArray positions |
  34          selector := role selector.
  35          findOnArray := (Array newSize: selector arity).
  36          positions := role rolePositions.
  37          findOnArray keysDo:
  38            [| :position |
  39             findOnArray at: position put:
  40               ((positions bitAnd: 1 << position) isZero
  41                  ifTrue: [NoRole] ifFalse: [x]).
  42             (role selector findOn: findOnArray) ifNotNilDo:
  43               [| :method |
  44                (method isSameAs: PrimitiveMethod) ifFalse:
  45                  [result nextPut: method method]]]]]
  46   ] writingAs: Set
  47 ].
  48
  49 x@(Root traits) mostCommonlyCalledMethods
  50 [
  51   x methodsUsingMe sortBy: [| :x :y | x callCount >= y callCount]
  52 ].
  53
  54 x@(Root traits) printMostCommonlyCalledMethods
  55 [
  56   x mostCommonlyCalledMethods do:
  57     [| :m | inform: '%@ count: %@ at: %r', m, m callCount, m definitionLocation].
  58 ].
  59
  60 m@(CompiledMethod traits) breakOnEntry
  61 [| regCount |
  62   regCount := m registerCount.
  63   m registerCount := regCount + 2.
  64   m method code := {VM SSACode loadEnvironment. regCount.
  65                     VM SSACode directSendMessage. regCount + 1. #break. 1. regCount} ; m method code.
  66 ].
  67
  68 m@(CompiledMethod traits) clearBreaks
  69 [m recompile].
  70
  71 obj@(Root traits) completeSelectorFrom: s@(String traits)
  72 [
  73   obj allRoles
  74     select: [| :item | (item value bitAnd: 1) = 1 /\ [item key beginsWith: s]]
  75     collect: #key `er
  76 ].
  77
  78 m@(Method traits) reload
  79 [
  80   m sourceTree ifNotNilDo:
  81     [| :src | (src source resource as: Module) load]
  82 ].