Add experimental disassembler

core/alien/compiler/compiler.factor

@@ -326,7 +326,7 @@ M: alien-callback-error summary
     drop "Words calling ``alien-callback'' must be compiled with the optimizing compiler." ;
 
 : callback-bottom ( node -- )
-    alien-callback-xt [ word-xt <alien> ] curry
+    alien-callback-xt [ word-xt drop <alien> ] curry
     recursive-state get infer-quot ;
 
 \ alien-callback [

core/words/words-docs.factor

@@ -245,8 +245,8 @@ HELP: remove-word-prop
 { $description "Removes a word property, so future lookups will output " { $link f } " until it is set again. Word property names are conventionally strings." }
 { $side-effects "word" } ;
 
-HELP: word-xt
-{ $values { "word" word } { "xt" "an execution token integer" } }
+HELP: word-xt ( word -- start end )
+{ $values { "word" word } { "start" "the word's start address" } { "end" "the word's end address" } }
 { $description "Outputs the machine code address of the word's definition." } ;
 
 HELP: define-symbol

extra/tools/disassembler/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/tools/disassembler/disassembler.factor

@@ -0,0 +1,31 @@
+USING: io.files io words alien kernel math.parser alien.syntax
+io.launcher system assocs arrays ;
+IN: tools.disassembler
+
+GENERIC: make-disassemble-cmd ( word -- file )
+
+M: word make-disassemble-cmd
+    word-xt 2array make-disassemble-cmd ;
+
+M: pair make-disassemble-cmd
+    "gdb.txt" resource-path [
+        [
+            "disassemble " write
+            [ number>string write bl ] each
+        ] with-file-out
+    ] keep ;
+
+: run-gdb ( cmds -- output )
+    [
+        +closed+ +stdin+ set
+        [
+            "gdb" ,
+            vm ,
+            getpid number>string ,
+            "-x" , ,
+            "-batch" ,
+        ] { } make +arguments+ set
+    ] { } make-assoc <process-stream> contents ;
+
+: disassemble ( word -- )
+    make-disassemble-cmd run-gdb write ;

extra/tools/disassembler/summary.txt

@@ -0,0 +1 @@
+Disassemble words using gdb

extra/unix/unix.factor

@@ -125,6 +125,7 @@ FUNCTION: int futimes ( int id, timeval[2] times ) ;
 FUNCTION: char* gai_strerror ( int ecode ) ;
 FUNCTION: int getaddrinfo ( char* hostname, char* servname, addrinfo* hints, addrinfo** res ) ;
 FUNCTION: char* getcwd ( char* buf, size_t size ) ;
+FUNCTION: pid_t getpid ;
 FUNCTION: int getdtablesize ;
 FUNCTION: gid_t getegid ;
 FUNCTION: uid_t geteuid ;

vm/types.c

@@ -70,11 +70,13 @@ DEFINE_PRIMITIVE(word)
 	dpush(tag_object(allot_word(vocab,name)));
 }
 
-/* word-xt ( word -- xt ) */
+/* word-xt ( word -- start end ) */
 DEFINE_PRIMITIVE(word_xt)
 {
-	F_WORD *word = untag_word(dpeek());
-	drepl(allot_cell((CELL)word->xt));
+	F_WORD *word = untag_word(dpop());
+	F_COMPILED *code = word->code;
+	dpush(allot_cell((CELL)code + sizeof(F_COMPILED)));
+	dpush(allot_cell((CELL)code + sizeof(F_COMPILED) + code->code_length));
 }
 
 DEFINE_PRIMITIVE(wrapper)