src/mobius/disassemble.slate

   1 CompiledMethod traits define: #OpStream &parents: {ReadStream}
   2  &slots: {#codePosition -> 0. #method -> Nil}.
   3
   4 CompiledMethod traits define: #Instruction &slots: {#name. #arguments -> {}}.
   5 "An Instruction just stores the name of the op-code and the arguments for it."
   6
   7 method@(CompiledMethod traits) opReader
   8 [method OpStream newOn: method].
   9
  10 s@(CompiledMethod OpStream traits) on: method@(CompiledMethod traits)
  11 [
  12   s method := method.
  13   s codePosition := 0.
  14   s
  15 ].
  16
  17 s@(CompiledMethod OpStream traits) hasAnEnd [True].
  18
  19 s@(CompiledMethod OpStream traits) isAtEnd
  20 [s codePosition >= s method code size].
  21
  22 s@(CompiledMethod OpStream traits) decodeShort
  23 "Get the next two bytes and turn them into a SmallInteger appropriately
  24 and advance the index."
  25 [| n val |
  26   n := s codePosition.
  27   val := (s method code at: n) + ((s method code at: n + 1) << 8).
  28   s codePosition := n + 2.
  29   val > 16r7FFF
  30     ifTrue: [-16r8000 + (val bitAnd: 16r7FFF)]
  31     ifFalse: [val]
  32 ].
  33
  34 s@(CompiledMethod OpStream traits) decodeImmediate
  35 "Find the next encoded SmallInteger starting with the trailing 3 bits of the
  36 byte and then any following bytes as encoded, advancing the index."
  37 [| n code val |
  38   n := s codePosition.
  39   code := s method code at: n.
  40   val := code bitAnd: 16r7F.
  41   [code >= 16r80]
  42     whileTrue:
  43       [n += 1.
  44        code := s method code at: n.
  45        val := val << 7 bitOr: (code bitAnd: 16r7F)].
  46   s codePosition := n + 1.
  47   val
  48 ].
  49
  50 s@(CompiledMethod OpStream traits) next
  51 "Answer an Instruction object representing the next instruction. Immediate
  52 values are decoded, and literal values are printed as appropriate."
  53 [| op val name extraInfo |
  54   "Get the opcode, increment our index, and get the next immediate value."
  55   op := s method code at: s codePosition.
  56   s codePosition := s codePosition + 1.
  57   (op bitAnd: 16r0F) = 16r0F
  58     ifFalse:
  59       [val := op >> 4.
  60        val = 16rF ifTrue: [val := s decodeImmediate].
  61        op := op bitAnd: 16r0F].
  62   "Find the Instruction's name."
  63   VM ByteCode slotNamesAndValuesDo:
  64     [| :slotName :code | code = op ifTrue: [name := slotName]].
  65   "Set up the Instruction object with the name and all the available arguments."
  66   CompiledMethod Instruction clone `setting: #{#name. #arguments} to:
  67     {name.
  68      (name
  69        caseOf:
  70          {#loadFreeVariable -> [{val. s decodeImmediate}].
  71           #storeFreeVariable -> [{val. s decodeImmediate}].
  72           #loadLiteral -> [{val. s method literals at: val}].
  73           #loadSelector -> [{val. s method selectors at: val}].
  74           #jumpTo -> [{s decodeShort}].
  75           #branchIfTrue -> [{s decodeShort}].
  76           #branchIfFalse -> [{s decodeShort}]}
  77        otherwise:
  78          [val ifNil: [#{}] ifNotNil: [{val}]])}
  79 ].
  80
  81 i@(CompiledMethod Instruction traits) disassembleOn: s
  82 "For each opcode, print out the name and then each of the arguments on a line."
  83 [
  84   s ; i name name.
  85   i arguments do: [| :arg | s ; ' ' ; arg printString].
  86   s ; '\n'.
  87 ].
  88
  89 i@(CompiledMethod OpStream traits) disassembleOn: s
  90 "Print out each opcode, prefixed by the instruction offset number."
  91 [| offset |
  92   offset := 0.
  93   i do: [| :each |
  94     s ; offset printString ; ': '.
  95     each disassembleOn: s.
  96     offset := i codePosition].
  97 ].
  98
  99 m@(CompiledMethod traits) printInstructionAt: pos on: out
 100 [| opcode instr nextStart argOffset |
 101   opcode := m code at: pos.
 102   instr := VM SSACode Instruction ByCode at: opcode
 103     ifAbsent: [error: 'Cannot find instruction  at ' ; pos printString ; ' in ' ; m code printString].
 104   out ; (pos printString truncateTo: 5 paddedBy: $\s &onRight: True)
 105     ; (opcode printString truncateTo: 3 paddedBy: $\s &onRight: True)
 106     ; (instr name truncateTo: 25 paddedBy: $\s &onRight: True)
 107     ; '\n'.
 108   nextStart := instr offsettingArgIndices inject: pos + 1 + instr argNames size
 109     into: [| :sum :offset | sum + (m code at: pos + 1 + offset)].
 110   argOffset := 0.
 111   (pos + 1 until: nextStart) do:
 112     [| :codeIndex |
 113      out ; '     ' ; (m code at: codeIndex) printString
 114          ; ' ' ; (argOffset < instr argNames size ifTrue: [instr argNames at: argOffset] ifFalse: ['']) ; '\n'.
 115      argOffset += 1].
 116   nextStart
 117 ].
 118
 119
 120 m@(CompiledMethod traits) printCondensedInstructionAt: pos on: out
 121 [| opcode instr nextStart argOffset |
 122   opcode := m code at: pos.
 123   instr := VM SSACode Instruction ByCode at: opcode
 124     ifAbsent: [error: 'Cannot find instruction  at ' ; pos printString ; ' in ' ; m code printString].
 125   out ; (pos printString truncateTo: 5 paddedBy: $\s &onRight: True)
 126     ; (opcode printString truncateTo: 3 paddedBy: $\s &onRight: True)
 127     ; instr name
 128     ; '*'.
 129   nextStart := instr offsettingArgIndices inject: pos + 1 + instr argNames size
 130     into: [| :sum :offset | sum + (m code at: pos + 1 + offset)].
 131   argOffset := 0.
 132   (pos + 1 until: nextStart) do:
 133     [| :codeIndex |
 134      out ; ', ' ; (m code at: codeIndex) printString.
 135      argOffset < instr argNames size ifTrue: [out ; ' ' ; (instr argNames at: argOffset)].
 136      argOffset += 1].
 137   out ; '\n'.
 138   nextStart
 139 ].
 140
 141 m@(CompiledMethod traits) printInstructionsOn: out &condensed: condensed
 142 [| pos |
 143   condensed `defaultsTo: False.
 144   out ; 'IP   ' ; 'OP ' ; 'Instruction' ; '\n'.
 145   pos := 0.
 146   [pos < m code size] whileTrue:
 147     [pos := condensed
 148        ifTrue: [m printCondensedInstructionAt: pos on: out]
 149        ifFalse: [m printInstructionAt: pos on: out]].
 150 ].
 151
 152 m@(CompiledMethod traits) disassemble &output: s &condensed: condensed
 153 "Print out method meta-data and then the instruction stream."
 154 [
 155   s `defaultsTo: Console writer.
 156   s writer
 157     ; 'name: ' ; (m selector ifNil: ['(anonymous)'] ifNotNil: [m selector name printString]) ; '\n'
 158     ; '#inputs: ' ; m inputVariables printString ; '\n'
 159     ; '#locals: ' ; m localVariables printString ; '\n'
 160     ; 'allocation: ' ; (m heapAllocate ifTrue: ['heap'] ifFalse: ['stack']) ; '\n'
 161     ; 'rest parameter: ' ; m restVariable printString ; '\n'
 162     ; 'optional keywords: ' ; (m optionalKeywords isEmpty
 163          ifTrue: ['(none)'] ifFalse: [m optionalKeywords join &separator: ' '])  ; '\n'.
 164   m printInstructionsOn: s &condensed: condensed.
 165 ].
 166
 167 closure@(Closure traits) disassemble &output: s &condensed: condensed
 168 "Skip Closure objects and print their internal methods instead."
 169 [closure method disassemble &output: s &condensed: condensed].