Diff for /gforth/arch/alpha/disasm.fs between versions 1.1 and 1.9

version 1.1, 1999/09/30 14:01:09 version 1.9, 2007/12/31 19:02:24
Line 1 Line 1
   
 \ bernd thallner 9725890 e881  
 \ disassembler in forth for alpha  \ disassembler in forth for alpha
   
 \ format  \ Copyright (C) 1999,2000,2007 Free Software Foundation, Inc.
   
   \ This file is part of Gforth.
   
   \ Gforth is free software; you can redistribute it and/or
   \ modify it under the terms of the GNU General Public License
   \ as published by the Free Software Foundation, either version 3
   \ of the License, or (at your option) any later version.
   
   \ This program is distributed in the hope that it will be useful,
   \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   \ GNU General Public License for more details.
   
 0 constant cOpc  \ You should have received a copy of the GNU General Public License
 1 constant cBra  \ along with this program. If not, see http://www.gnu.org/licenses/.
 2 constant cF-P  
 3 constant cMem  \ contributed by Bernd Thallner
 4 constant cMfc  
 5 constant cMbr  
 6 constant cOpr  
 7 constant cPcd  
   
 \ util  \ util
   
 : right_shift ( a n -- a>>=n )  \ require asm.fs
 0  
 ?do  \  : h@ ( addr -- n )  \ 32 bit fetch
   2/  \  dup dup aligned = if
 loop  \    @
 ;  \    $00000000ffffffff and
   \  else
 : left_shift ( a n -- a<<=n )  \    4 - @
 0  \    $20 rshift
 ?do  \  endif
   2*  \  ;
 loop  
 ;  also assembler
   vocabulary disassembler
 : h@ ( addr -- n )  \ 32 bit fetch  get-current
 dup dup aligned = if  also disassembler definitions
   @  
   $00000000ffffffff and  
 else  
   4 - @  
   $20 right_shift  
 endif  
 ;  
   
 create string_table  create string_table
 1000 allot  1000 allot
Line 47  create string_table Line 46  create string_table
   
 : mktbentry, { start format straddr strlen -- start }  \ make table entry  : mktbentry, { start format straddr strlen -- start }  \ make table entry
   straddr string_table start + strlen cmove    straddr string_table start + strlen cmove
   start 48 left_shift    start 48 lshift
   strlen 32 left_shift or    strlen 32 lshift or
   format or    format or
   ,    ,
   start strlen +    start strlen +
Line 59  create string_table Line 58  create string_table
   
 : print_string ( table_entry -- )  \ print string entry  : print_string ( table_entry -- )  \ print string entry
   dup    dup
   48 right_shift string_table +    48 rshift string_table +
   swap    swap
   32 right_shift $000000000000ffff and    32 rshift $000000000000ffff and
   type    type
 ;  ;
   
Line 81  create string_table Line 80  create string_table
   
 0 \ string_table offset  0 \ string_table offset
   
 create opcode_table  
   
 ( 00 ) cPcd s" call_pal"    mktbentry,  
 ( 01 ) cOpc s" opc01"       mktbentry,  
 ( 02 ) cOpc s" opc02"       mktbentry,  
 ( 03 ) cOpc s" opc03"       mktbentry,  
 ( 04 ) cOpc s" opc04"       mktbentry,  
 ( 05 ) cOpc s" opc05"       mktbentry,  
 ( 06 ) cOpc s" opc06"       mktbentry,  
 ( 07 ) cOpc s" opc07"       mktbentry,  
 ( 08 ) cMem s" lda"         mktbentry,  
 ( 09 ) cMem s" ldah"        mktbentry,  
 ( 0a ) cOpc s" opc0a"       mktbentry,  
 ( 0b ) cMem s" ldq_u"       mktbentry,  
 ( 0c ) cOpc s" opc0c"       mktbentry,  
 ( 0d ) cOpc s" opc0d"       mktbentry,  
 ( 0e ) cOpc s" opc0e"       mktbentry,  
 ( 0f ) cMem s" stq_u"       mktbentry,  
 ( 10 ) cOpr s" "            mktbentry,  
 ( 11 ) cOpr s" "            mktbentry,  
 ( 12 ) cOpr s" "            mktbentry,  
 ( 13 ) cOpr s" "            mktbentry,  
 ( 14 ) cOpc s" opc14"       mktbentry,  
 ( 15 ) cF-P s" "            mktbentry,  
 ( 16 ) cF-P s" "            mktbentry,  
 ( 17 ) cF-P s" "            mktbentry,  
 ( 18 ) cMfc s" "            mktbentry,  
 ( 19 ) cOpc s" pal19"       mktbentry,  
 ( 1a ) cMbr s" "            mktbentry,  
 ( 1b ) cOpc s" pal1b"       mktbentry,  
 ( 1c ) cOpc s" opc1c"       mktbentry,  
 ( 1d ) cOpc s" pal1d"       mktbentry,  
 ( 1e ) cOpc s" pal1e"       mktbentry,  
 ( 1f ) cOpc s" pal1f"       mktbentry,  
 ( 20 ) cMem s" ldf"         mktbentry,  
 ( 21 ) cMem s" ldg"         mktbentry,  
 ( 22 ) cMem s" lds"         mktbentry,  
 ( 23 ) cMem s" ldt"         mktbentry,  
 ( 24 ) cMem s" stf"         mktbentry,  
 ( 25 ) cMem s" stg"         mktbentry,  
 ( 26 ) cMem s" sts"         mktbentry,  
 ( 27 ) cMem s" stt"         mktbentry,  
 ( 28 ) cMem s" ldl"         mktbentry,  
 ( 29 ) cMem s" ldq"         mktbentry,  
 ( 2a ) cMem s" ldl_l"       mktbentry,  
 ( 2b ) cMem s" ldq_l"       mktbentry,  
 ( 2c ) cMem s" stl"         mktbentry,  
 ( 2d ) cMem s" stq"         mktbentry,  
 ( 2e ) cMem s" stl_c"       mktbentry,  
 ( 2f ) cMem s" stq_c"       mktbentry,  
 ( 30 ) cBra s" br"          mktbentry,  
 ( 31 ) cBra s" fbeq"        mktbentry,  
 ( 32 ) cBra s" fblt"        mktbentry,  
 ( 33 ) cBra s" fble"        mktbentry,  
 ( 34 ) cBra s" bsr"         mktbentry,  
 ( 35 ) cBra s" fbne"        mktbentry,  
 ( 36 ) cBra s" fbge"        mktbentry,  
 ( 37 ) cBra s" fbgt"        mktbentry,  
 ( 38 ) cBra s" blbc"        mktbentry,  
 ( 39 ) cBra s" beq"         mktbentry,  
 ( 3a ) cBra s" blt"         mktbentry,  
 ( 3b ) cBra s" ble"         mktbentry,  
 ( 3c ) cBra s" blbs"        mktbentry,  
 ( 3d ) cBra s" bne"         mktbentry,  
 ( 3e ) cBra s" bge"         mktbentry,  
 ( 3f ) cBra s" bgt"         mktbentry,  
   
 create Opr_list  create Opr_list
   
 $00 tab0 s" addl"          mktbentry,  $00 tab0 s" addl"          mktbentry,
Line 329  create register_table Line 261  create register_table
 ( 1e ) 0 s" sp"           mktbentry,  ( 1e ) 0 s" sp"           mktbentry,
 ( 1f ) 0 s" zero"         mktbentry,  ( 1f ) 0 s" zero"         mktbentry,
   
 drop \ string_table end  
   
 defer decode_register  defer decode_register
   
 : decode_register_symb ( register -- )  : decode_register_symb ( register -- )
Line 345  defer decode_register Line 275  defer decode_register
 ' decode_register_number is decode_register  ' decode_register_number is decode_register
 \ ' decode_register_symb is decode_register  \ ' decode_register_symb is decode_register
   
   create decode_code
   
 : decode_Opc ( instruction tbentry -- )  : decode_Opc ( instruction tbentry -- )
   print_string drop    print_string drop
 ;  ;
   
 : decode_Bra ( instruction tbentry -- )  : decode_Bra ( addr instruction tbentry -- addr )
   swap    swap
   dup $03e00000 and 21 right_shift decode_register    dup $03e00000 and 21 rshift decode_register
   $001fffff and .    $001fffff and 2* 2* 2 pick + 4 + hex.
   print_string    print_string
 ;  ;
   
 : decode_F-P ( instruction tbentry -- )  : decode_F-P ( instruction tbentry -- )
   drop    drop
   dup $03e00000 and 21 right_shift decode_register    dup $03e00000 and 21 rshift decode_register
   dup $001f0000 and 16 right_shift decode_register    dup $001f0000 and 16 rshift decode_register
   dup $0000001f and decode_register    dup $0000001f and decode_register
   dup 26 right_shift $15 -    dup 26 rshift $15 -
   swap $0000fff0 and 3 right_shift or F-P_list    swap $0000fff0 and 3 rshift or F-P_list
   begin    begin
     dup @ rot swap over over $00000000ffffffff and      dup @ rot swap over over $00000000ffffffff and
     = if print_string swap drop register_table swap else drop endif      = if print_string swap drop register_table swap else drop endif
Line 373  defer decode_register Line 305  defer decode_register
   
 : decode_Mem ( instruction tbentry -- )  : decode_Mem ( instruction tbentry -- )
   swap    swap
   dup $03e00000 and 21 right_shift decode_register    dup $03e00000 and 21 rshift decode_register
   dup $0000ffff and .    dup $0000ffff and dup 15 rshift negate 15 lshift or .
   $001f0000 and 16 right_shift decode_register    $001f0000 and 16 rshift decode_register
   print_string    print_string
 ;  ;
   
 : decode_Mfc ( instruction tbentry -- )  : decode_Mfc ( instruction tbentry -- )
   drop    drop
   dup $03e00000 and 21 right_shift decode_register    dup $03e00000 and 21 rshift decode_register
   dup $001f0000 and 16 right_shift decode_register    dup $001f0000 and 16 rshift decode_register
   $0000ffff and Mfc_list    $0000ffff and Mfc_list
   begin    begin
     dup @ rot swap over over $00000000ffffffff and      dup @ rot swap over over $00000000ffffffff and
Line 394  defer decode_register Line 326  defer decode_register
   
 : decode_Mbr ( instruction tbentry -- )  : decode_Mbr ( instruction tbentry -- )
   drop    drop
   dup $03e00000 and 21 right_shift decode_register    dup $03e00000 and 21 rshift decode_register
   dup $001f0000 and 16 right_shift decode_register    dup $001f0000 and 16 rshift decode_register
   dup $00003fff and decode_register    dup $00003fff and decode_register
   $0000c000 and 14 right_shift cells Mbr_table +    $0000c000 and 14 rshift cells Mbr_table +
   @ print_string    @ print_string
 ;  ;
   
 : decode_Opr ( instruction tbentry -- )  : decode_Opr ( instruction tbentry -- )
   drop    drop
   dup $03e00000 and 21 right_shift decode_register    dup $03e00000 and 21 rshift decode_register
   dup dup $00001000 and $00001000    dup dup $00001000 and $00001000
   = if    = if
     $001fe000 and 13 right_shift . -1      $001fe000 and 13 rshift . -1
   else    else
     $001f0000 and 16 right_shift decode_register 0      $001f0000 and 16 rshift decode_register 0
   endif    endif
   swap dup $0000001f and decode_register    swap dup $0000001f and decode_register
   dup 26 right_shift $10 -    dup 26 rshift $10 -
   swap $00000fe0 and 3 right_shift or Opr_list    swap $00000fe0 and 3 rshift or Opr_list
   begin    begin
     dup @ rot swap over over $00000000ffffffff and      dup @ rot swap over over $00000000ffffffff and
     = if print_string swap drop register_table swap else drop endif      = if print_string swap drop register_table swap else drop endif
Line 427  defer decode_register Line 359  defer decode_register
   print_string    print_string
 ;  ;
   
 : decode_inst ( n -- )  \ instruction decoder  \ format
   
   ' decode_Opc decode_code - constant cOpc
   ' decode_Bra decode_code - constant cBra
   ' decode_F-P decode_code - constant cF-P
   ' decode_Mem decode_code - constant cMem
   ' decode_Mfc decode_code - constant cMfc
   ' decode_Mbr decode_code - constant cMbr
   ' decode_Opr decode_code - constant cOpr
   ' decode_Pcd decode_code - constant cPcd
   
   create opcode_table
   
   ( 00 ) cPcd s" call_pal" mktbentry,
   ( 01 ) cOpc s" opc01"       mktbentry,
   ( 02 ) cOpc s" opc02"       mktbentry,
   ( 03 ) cOpc s" opc03"       mktbentry,
   ( 04 ) cOpc s" opc04"       mktbentry,
   ( 05 ) cOpc s" opc05"       mktbentry,
   ( 06 ) cOpc s" opc06"       mktbentry,
   ( 07 ) cOpc s" opc07"       mktbentry,
   ( 08 ) cMem s" lda"         mktbentry,
   ( 09 ) cMem s" ldah"        mktbentry,
   ( 0a ) cOpc s" opc0a"       mktbentry,
   ( 0b ) cMem s" ldq_u"       mktbentry,
   ( 0c ) cOpc s" opc0c"       mktbentry,
   ( 0d ) cOpc s" opc0d"       mktbentry,
   ( 0e ) cOpc s" opc0e"       mktbentry,
   ( 0f ) cMem s" stq_u"       mktbentry,
   ( 10 ) cOpr s" "            mktbentry,
   ( 11 ) cOpr s" "            mktbentry,
   ( 12 ) cOpr s" "            mktbentry,
   ( 13 ) cOpr s" "            mktbentry,
   ( 14 ) cOpc s" opc14"       mktbentry,
   ( 15 ) cF-P s" "            mktbentry,
   ( 16 ) cF-P s" "            mktbentry,
   ( 17 ) cF-P s" "            mktbentry,
   ( 18 ) cMfc s" "            mktbentry,
   ( 19 ) cOpc s" pal19"       mktbentry,
   ( 1a ) cMbr s" "            mktbentry,
   ( 1b ) cOpc s" pal1b"       mktbentry,
   ( 1c ) cOpc s" opc1c"       mktbentry,
   ( 1d ) cOpc s" pal1d"       mktbentry,
   ( 1e ) cOpc s" pal1e"       mktbentry,
   ( 1f ) cOpc s" pal1f"       mktbentry,
   ( 20 ) cMem s" ldf"         mktbentry,
   ( 21 ) cMem s" ldg"         mktbentry,
   ( 22 ) cMem s" lds"         mktbentry,
   ( 23 ) cMem s" ldt"         mktbentry,
   ( 24 ) cMem s" stf"         mktbentry,
   ( 25 ) cMem s" stg"         mktbentry,
   ( 26 ) cMem s" sts"         mktbentry,
   ( 27 ) cMem s" stt"         mktbentry,
   ( 28 ) cMem s" ldl"         mktbentry,
   ( 29 ) cMem s" ldq"         mktbentry,
   ( 2a ) cMem s" ldl_l"       mktbentry,
   ( 2b ) cMem s" ldq_l"       mktbentry,
   ( 2c ) cMem s" stl"         mktbentry,
   ( 2d ) cMem s" stq"         mktbentry,
   ( 2e ) cMem s" stl_c"       mktbentry,
   ( 2f ) cMem s" stq_c"       mktbentry,
   ( 30 ) cBra s" br"          mktbentry,
   ( 31 ) cBra s" fbeq"        mktbentry,
   ( 32 ) cBra s" fblt"        mktbentry,
   ( 33 ) cBra s" fble"        mktbentry,
   ( 34 ) cBra s" bsr"         mktbentry,
   ( 35 ) cBra s" fbne"        mktbentry,
   ( 36 ) cBra s" fbge"        mktbentry,
   ( 37 ) cBra s" fbgt"        mktbentry,
   ( 38 ) cBra s" blbc"        mktbentry,
   ( 39 ) cBra s" beq"         mktbentry,
   ( 3a ) cBra s" blt"         mktbentry,
   ( 3b ) cBra s" ble"         mktbentry,
   ( 3c ) cBra s" blbs"        mktbentry,
   ( 3d ) cBra s" bne"         mktbentry,
   ( 3e ) cBra s" bge"         mktbentry,
   ( 3f ) cBra s" bgt"         mktbentry,
   
   drop \ string_table end
   
   set-current
   
   : disasm-inst ( addr n -- addr )  \ instruction decoder
   dup $fc000000 and    dup $fc000000 and
   26 right_shift cells    26 rshift cells
   opcode_table +    opcode_table +
   @ dup    @ dup $00000000ffffffff and
   $000000000000ffff and    decode_code + execute
   dup cOpc = if drop decode_Opc     $2c emit cr
     else dup cF-P = if drop decode_F-P  ;
       else dup cOpr = if drop decode_Opr  
         else dup cMfc = if drop decode_Mfc  : disasm ( addr u -- )  \ gforth
           else dup cMbr = if drop decode_Mbr      \G disassemble u aus starting at addr
             else dup cMem = if drop decode_Mem      cr bounds
               else dup cBra = if drop decode_Bra      u+do
                 else dup cPcd = if drop decode_Pcd          ." ( " i hex. ." ) "
                                endif          i i h@ disasm-inst drop
                              endif          4
                            endif      +loop ;
                          endif  
                        endif  ' disasm is discode
                      endif  
                    endif  previous previous
                  endif  
   $2c emit $a emit  
 ;  
   
 : disasm ( addr n -- )  \ disassembler  
 $a emit 0  
 ?do  
   dup h@  
   over $28 emit $20 emit . $29 emit $20 emit  
   decode_inst  
   4 +  
 loop  
 drop $a emit  
 ;  

Removed from v.1.1  
changed lines
  Added in v.1.9


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>