--- gforth/arch/alpha/disasm.fs	1999/10/13 13:00:08	1.2
+++ gforth/arch/alpha/disasm.fs	2000/06/17 19:38:28	1.4
@@ -4,15 +4,22 @@
 
 \ util
 
-: h@ ( addr -- n )  \ 32 bit fetch
-dup dup aligned = if
-  @
-  $00000000ffffffff and
-else
-  4 - @
-  $20 rshift
-endif
-;
+require asm.fs
+
+\  : h@ ( addr -- n )  \ 32 bit fetch
+\  dup dup aligned = if
+\    @
+\    $00000000ffffffff and
+\  else
+\    4 - @
+\    $20 rshift
+\  endif
+\  ;
+
+also assembler
+vocabulary disassembler
+get-current
+also disassembler definitions
 
 create string_table
 1000 allot
@@ -260,7 +267,7 @@ create decode_code
 : decode_Bra ( instruction tbentry -- )
   swap
   dup $03e00000 and 21 rshift decode_register
-  $001fffff and .
+  $001fffff and hex.
   print_string
 ;
 
@@ -282,7 +289,7 @@ create decode_code
 : decode_Mem ( instruction tbentry -- )
   swap
   dup $03e00000 and 21 rshift decode_register
-  dup $0000ffff and .
+  dup $0000ffff and dup 15 rshift negate 15 lshift or .
   $001f0000 and 16 rshift decode_register
   print_string
 ;
@@ -415,7 +422,9 @@ create opcode_table
 
 drop \ string_table end
 
-: decode_inst ( n -- )  \ instruction decoder
+set-current
+
+: disasm-inst ( n -- )  \ instruction decoder
   dup $fc000000 and
   26 rshift cells
   opcode_table +
@@ -424,13 +433,15 @@ drop \ string_table end
   $2c emit cr
 ;
 
-: disasm ( addr n -- )  \ disassembler
-cr 0
-?do
-  dup h@
-  over $28 emit space . $29 emit space
-  decode_inst
-  4 +
-loop
-drop
-;
+: disasm ( addr u -- )  \ gforth
+    \G disassemble u aus starting at addr
+    cr bounds
+    u+do
+	." ( " i hex. ."  ) "
+	i h@ disasm-inst
+	4
+    +loop ;
+
+' disasm is discode
+
+previous previous