Replaced instructionInfo with more informative objects for the disassemble method...

diff --git a/src/mobius/compiler.slate b/src/mobius/compiler.slate
index 5746840..58d84d5 100644 (file)
--- a/src/mobius/compiler.slate
+++ b/src/mobius/compiler.slate
@@ -1,4 +1,17 @@
 
+m@(CompiledMethod traits) new
+"Answer a new CompiledMethod with a fresh compilation state."
+[
+  m clone `>>
+    [| :newM |
+      method: newM.
+      literals: m literals new.
+      selectors: m selectors new.
+      optionalKeywords: m optionalKeywords new.
+      code: m code new.
+      debugMap: m debugMap new. ]
+].
+
 m@(CompiledMethod traits) sourceTreeOf: index
 "Find the source tree corresponding to a bytecode's index."
 [
@@ -22,19 +35,6 @@ m@(CompiledMethod traits) definitionLocation
                ifNotNil: [(m sourceTree source printString) ; ':' ; m sourceTree lineNumber printString]]
 ].
 
-m@(CompiledMethod traits) new
-"Answer a new CompiledMethod with a fresh compilation state."
-[
-  m clone `>>
-    [| :newM |
-      method: newM.
-      literals: m literals new.
-      selectors: m selectors new.
-      optionalKeywords: m optionalKeywords new.
-      code: m code new.
-      debugMap: m debugMap new. ]
-].
-
 m@(CompiledMethod traits) recompile
 "If the method has a sourceTree, replace the method with a re-compiled version
 of it."
@@ -47,6 +47,74 @@ of it."
 lobby ensureNamespace: #VM.
 VM ensureNamespace: #SSACode.
 
+VM SSACode define: #Instruction &parents: {Cloneable} &slots: {
+  #code.
+  #name.
+  #argNames -> {}.
+  #offsettingArgIndices -> {}.
+}.
+
+x@(Cloneable traits) instancesSetting: slotNames to: values
+[
+  values collect: [| :columnValues newX |
+    newX: x new.
+    slotNames with: columnValues do:
+      [| :slotName :slotValue | newX atSlotNamed: slotName put: slotValue].
+    newX]
+].
+
+VM SSACode Instruction traits define: #ByCode -> Dictionary new.
+
+i@(VM SSACode Instruction traits) instancesSetting: slotNames to: values
+[| arityNames |
+  arityNames: #('arity' 'size').
+  resend `>> [do: [| :each |
+    each argNames do:
+      [| :argName | (arityNames includes: argName) ifTrue:
+        [""]].
+    i ByCode at: each code put: each].
+  ]
+].
+
+VM SSACode Instruction instancesSetting: #(code name argNames offsettingArgIndices) to: {
+  {0. 'Direct Send'. {'register of result'. 'selector'. 'arity' ". args..."}. {2}}.
+  "{1. 'Indirect Send'. {'register of result'. 'selector'. 'arity'. args...}. {2}}."
+  "{2. 'Allocate Registers'. 3. {}}."
+  {3. 'Load Literal'. {'register of result'. 'index of literal'}}.
+  "{4. 'Store Literal'. {'index of literal'. 'register of source'}}."
+  {5. 'Send with Optionals'. {'register of result'. 'register of selector'. 'arity'. 'register of optionals array' ". args..."}. {2}}.
+  {7. 'New Closure'. {'register of result'. 'block'}}.
+  {8. 'New Array With'. {'register of result'. 'size' ". args..."}. {1}}.
+  {9. 'Resend'. {'register of result'. 'lexical offset'}}.
+  {10. 'Return From'. {'register of result'. 'lexical offset'}}.
+  {11. 'Load Environment'. {'register of result'}}.
+  {12. 'Load Variable'. {'register of result'}}.
+  {13. 'Store Variable'. {'register of result'}}.
+  {14. 'Load Free Variable'. {'register of result'. 'lexical offset'. 'index of variable'}}.
+  {15. 'Store Free Variable'. {'lexical offset'. 'index of variable'. 'register of source'}}.
+  {16. 'Is Identical To'. {'register of result'. 'register of x'. 'register of y'}}.
+  {17. 'Branch Keyed'. {'register of key'. 'table'}}.
+  {18. 'Jump To'. {'offset'}}.
+  "Used like SSA phi / branch merges:"
+  {19. 'Move Register'. {'register of source'. 'register of result'}}.
+  {20. 'Branch If True'. {'register of condition'. 'branch offset'}}.
+  {21. 'Branch If False'. {'register of condition'. 'branch offset'}}.
+  "Marks the end of a block:"
+  {22. 'Return Register'. {'register of value'}}.
+  "Marks the end of a block:"
+  {23. 'Return Value'. {'value to return'}}.
+  "I'm not sure what this does yet..used in bootstrap:"
+  {24. 'Resume'. {}}.
+  {25. 'Primitive Do'. {'number of primitive'. 'arity'. 'register of result' ". args..."}. {1}}.
+  {26. 'Direct Apply To'. {'method'. 'arity'. 'register of result' ". args..."}. {1}}.
+  {27. 'Is Nil'. {'register of result'. 'register of x'}}.
+  "these check the arguments to see if their maps match the ones in the map array"
+  "if they match, we fall through to the next instruction which is the primitive (no code) or inlined function"
+  "it also needs to set up the input varibles"
+  {28. 'Inline Primitive Check Jump'. {'register of result'. 'map array'. 'prim number(in-opcode not a register)'. 'arity'. 'jump offset' ". args..."}. {3}}.
+  {29. 'Inline Method Check Jump'. {'map array'. 'arity'. 'jump offset' ". args..."}. {1}}.
+}.
+
 VM SSACode addImmutableSlot: #instructionInfo valued:
 { "the result or destination is usually the first argument"
 " the first item in the argument list is the number of arguments. numbers after that tell which items in the argument

diff --git a/src/mobius/disassemble.slate b/src/mobius/disassemble.slate
index 2dcbee8..c064cf5 100644 (file)
--- a/src/mobius/disassemble.slate
+++ b/src/mobius/disassemble.slate
@@ -97,23 +97,23 @@ i@(CompiledMethod OpStream traits) disassembleOn: s
 ].
 
 m@(CompiledMethod traits) printInstructionAt: pos on: out
-[| instr arguments nextStart instrVal |
-  instrVal: (m code at: pos).
-  instr: (VM SSACode instructionInfo detect: [| :elem | elem key = instrVal]
-                                     ifNone: [error: 'Cannot find instruction  at ' ; pos printString ; ' in ' ; m code printString]) value.
+[| opcode instr nextStart argOffset |
+  opcode: (m code at: pos).
+  instr: (VM SSACode Instruction ByCode at: opcode
+            ifAbsent: [error: 'Cannot find instruction  at ' ; pos printString ; ' in ' ; m code printString]).
   out ; (pos printString truncateTo: 5 paddedBy: $\s &onRight: True)
-    ; (instrVal printString truncateTo: 3 paddedBy: $\s &onRight: True)
-    ; (instr key printString truncateTo: 25 paddedBy: $\s &onRight: True).
-  nextStart: (pos + 1 + instr value first +
-    (instr value size > 1
-       ifTrue: [| sum |
-                sum: 0.
-                instr value allButFirstDo: [| :offset | sum: sum + (m code at: pos + 1 + offset)].
-                sum]
-       ifFalse: [0])).
+    ; (opcode printString truncateTo: 3 paddedBy: $\s &onRight: True)
+    ; (instr name truncateTo: 25 paddedBy: $\s &onRight: True)
+    ; '\n'.
+  nextStart: (pos + 1 + instr argNames size +
+    (instr offsettingArgIndices inject: 0 into:
+       [| :sum :offset | m code at: pos + 1 + offset])).
+  argOffset: 0.
   (pos + 1 until: nextStart) do:
-    [| :i | out ; ' ' ; (m code at: i) printString].
-  out ; '\n'.
+    [| :codeIndex |
+     out ; '     ' ; (m code at: codeIndex) printString
+         ; ' ' ; (argOffset < instr argNames size ifTrue: [instr argNames at: argOffset] ifFalse: ['']) ; '\n'.
+     argOffset: argOffset + 1].
   nextStart
 ].
 
@@ -130,9 +130,9 @@ m@(CompiledMethod traits) disassemble &output: s
 [
   s `defaultsTo: Console writer.
   s writer
-    ; 'name: ' ; (m selector ifNil: ['(anonymous)'] ifNotNil: [m selector name]) ; '\n'
-    ; 'inputs: ' ; m inputVariables printString ; '\n'
-    ; 'locals: ' ; m localVariables printString ; '\n'
+    ; 'name: ' ; (m selector ifNil: ['(anonymous)'] ifNotNil: [m selector name printString]) ; '\n'
+    ; '#inputs: ' ; m inputVariables printString ; '\n'
+    ; '#locals: ' ; m localVariables printString ; '\n'
     ; 'allocation: ' ; (m heapAllocate ifTrue: ['heap'] ifFalse: ['stack']) ; '\n'
     ; 'rest parameter: ' ; m restVariable printString ; '\n'
     ; 'optional keywords: ' ; (m optionalKeywords isEmpty