Annotation of gforth/arch/mips/disasm.fs, revision 1.15

1.15    ! dvdkhlng    1: \ disasm.fs    disassembler file (for MIPS32)
1.1       anton       2: \
1.14      anton       3: \ Copyright (C) 2000,2007 Free Software Foundation, Inc.
1.11      anton       4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
1.13      anton       9: \ as published by the Free Software Foundation, either version 3
1.11      anton      10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
1.13      anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.1       anton      19: 
1.4       anton      20: \ this disassembler is based on data from the R4400 manual
                     21: \ http://www.mips.com/Documentation/R4400_Uman_book_Ed2.pdf, in
1.6       anton      22: \ particular pages A3, A181, A182 (p. 471, 649, 650 in xpdf).
1.4       anton      23: \ it is limited to the R3000 (MIPS-I) architecture, though.
1.2       anton      24: 
1.7       anton      25: \ test this with
1.9       anton      26: \ gforth arch/mips/disasm.fs -e "here" arch/mips/testdisasm.fs -e "here over - disasm bye" |sed 's/([^)]*) //'|diff -u - arch/mips/testasm.fs
1.7       anton      27: 
1.8       anton      28: get-current
                     29: vocabulary disassembler
                     30: also disassembler definitions
                     31: 
1.4       anton      32: \ instruction fields
1.3       anton      33: 
                     34: : disasm-op ( w -- u )
                     35:     26 rshift ;
                     36: 
                     37: : disasm-rs ( w -- u )
                     38:     21 rshift $1F and ;
                     39: 
                     40: : disasm-rt ( w -- u )
                     41:     16 rshift $1f and ;
                     42: 
                     43: : disasm-rd ( w -- u )
                     44:     11 rshift $1f and ;
                     45: 
                     46: : disasm-shamt ( w -- u )
                     47:     \ shift amount field
                     48:     6 rshift $1f and ;
                     49: 
                     50: : disasm-funct ( w -- u )
                     51:     $3f and ;
                     52: 
                     53: : disasm-copz ( w -- u )
                     54:     disasm-op 3 and ;
                     55: 
1.5       anton      56: : disasm-uimm ( w -- u )
                     57:     $ffff and ;
                     58: 
1.3       anton      59: : disasm-imm ( w -- n )
1.5       anton      60:     disasm-uimm dup 15 rshift negate 15 lshift or ;
1.3       anton      61: 
                     62: : disasm-relative ( addr n -- w )
                     63:     \ compute printable form of relative address n relative to addr
1.6       anton      64:     2 lshift nip ( + ) ;
1.3       anton      65: 
1.4       anton      66: \ decode tables
                     67: 
                     68: : disasm-illegal ( addr w -- )
                     69:     \ disassemble illegal/unknown instruction w at addr
                     70:     hex. ." , ( illegal inst ) " drop ;
                     71: 
                     72: : disasm-table ( n "name" -- )
                     73:     \ initialize table with n entries with disasm-illegal
                     74:     create 0 ?do
                     75:        ['] disasm-illegal ,
                     76:     loop
                     77: does> ( u -- addr )
                     78:     swap cells + ;
                     79: 
                     80: $40 disasm-table opc-tab-entry     \ top-level decode table
                     81: $40 disasm-table funct-tab-entry   \ special function table
1.15    ! dvdkhlng   82: $40 disasm-table funct-tab2-entry  \ special2 function table
1.4       anton      83: $20 disasm-table regimm-tab-entry  \ regim instructions rt table
                     84: $20 disasm-table copz-rs-tab-entry \ COPz instructions rs table
                     85: $20 disasm-table copz-rt-tab-entry \ COPz BC instructions rt table
                     86: $40 disasm-table cp0-tab-entry     \ COP0 CO instructions funct table
                     87: 
1.3       anton      88: \ disassembler central decode cascade
                     89: 
1.8       anton      90: dup set-current
                     91: 
1.3       anton      92: : disasm-inst ( addr w -- )
                     93:     \G disassemble instruction w at addr (addr is used for computing
                     94:     \G branch targets)
1.4       anton      95:     dup disasm-op opc-tab-entry @ execute ;
1.3       anton      96: 
1.9       anton      97: : disasm ( addr u -- ) \ gforth
1.3       anton      98:     \G disassemble u aus starting at addr
                     99:     bounds u+do
1.15    ! dvdkhlng  100:        cr ." ( " i hex. ." ) " i i ul@ disasm-inst
        !           101:        4 +loop
1.10      anton     102:     cr ;
                    103: 
                    104: ' disasm IS discode
1.3       anton     105: 
1.8       anton     106: definitions
                    107: 
1.3       anton     108: : disasm-special ( addr w -- )
                    109:     \ disassemble inst with opcode special
1.4       anton     110:     dup disasm-funct funct-tab-entry @ execute ;
                    111: ' disasm-special 0 opc-tab-entry ! \ enter it for opcode special
1.3       anton     112: 
1.15    ! dvdkhlng  113: : disasm-special2 ( addr w -- ) \ todo factor out!
        !           114:     \ disassemble inst with opcode special2
        !           115:     dup disasm-funct funct-tab2-entry @ execute ;
        !           116: ' disasm-special2 $1C opc-tab-entry ! \ enter it for opcode special
        !           117: 
1.3       anton     118: : disasm-regimm ( addr w -- )
                    119:     \ disassemble regimm inst
1.4       anton     120:     dup disasm-rt regimm-tab-entry @ execute ;
                    121: ' disasm-regimm 1 opc-tab-entry ! \ enter it for opcode regimm
1.3       anton     122: 
                    123: : disasm-copz-rs ( addr w -- )
                    124:     \ disassemble inst with opcode COPz
1.4       anton     125:     dup disasm-rs copz-rs-tab-entry @ execute ;
                    126: ' disasm-copz-rs $10 opc-tab-entry ! \ enter it for opcodes COPz
                    127: ' disasm-copz-rs $11 opc-tab-entry !
                    128: ' disasm-copz-rs $12 opc-tab-entry !
1.3       anton     129: 
                    130: : disasm-copz-rt ( addr w -- )
                    131:     \ disassemble inst with opcode COPz, rs=BC
1.4       anton     132:     dup disasm-rt copz-rt-tab-entry @ execute ;
                    133: ' disasm-copz-rt $08 copz-rs-tab-entry ! \ into COPz-table for rs=BC
1.3       anton     134: 
                    135: : disasm-cp0 ( addr w -- )
                    136:     \ disassemble inst with opcode COPz, rs=CO
1.4       anton     137:     dup disasm-funct cp0-tab-entry @ execute ;
                    138: ' disasm-cp0 $10 copz-rs-tab-entry ! \ into COPz-table for rs=CO
1.3       anton     139: 
1.4       anton     140: \ dummy words for insts.fs (words with these names are needed by asm.fs)
1.3       anton     141: 
                    142: : asm-op ( -- ) ;
1.4       anton     143: : asm-rs ( -- ) ;
                    144: : asm-rt ( -- ) ;
                    145: 
                    146: \ disassemble various formats
1.3       anton     147: 
                    148: : disasm-J-target ( addr w -- )
                    149:     \ print jump target
1.7       anton     150:     2 lshift $0fffffff and swap $f0000000 and or hex. ;
1.3       anton     151: 
                    152: : disasm-I-rs,rt,imm ( addr w -- )
                    153:     dup disasm-rs .
                    154:     dup disasm-rt .
                    155:     disasm-imm disasm-relative . ;
                    156: 
                    157: : disasm-I-rs,imm ( addr w -- )
                    158:     dup disasm-rs .
                    159:     disasm-imm disasm-relative . ;
                    160: 
                    161: : disasm-rt,rs,imm ( addr w -- )
                    162:     dup disasm-rt .
                    163:     dup disasm-rs .
                    164:     disasm-imm .
                    165:     drop ;
1.1       anton     166: 
1.5       anton     167: : disasm-rt,rs,uimm ( addr w -- )
1.3       anton     168:     dup disasm-rt .
1.5       anton     169:     dup disasm-rs .
                    170:     disasm-uimm hex.
                    171:     drop ;
                    172: 
                    173: : disasm-rt,uimm ( addr w -- )
                    174:     dup disasm-rt .
                    175:     disasm-uimm hex.
1.1       anton     176:     drop ;
                    177: 
1.3       anton     178: : disasm-rt,imm,rs ( addr w -- )
                    179:     dup disasm-rt .
                    180:     dup disasm-imm .
                    181:     dup disasm-rs .
                    182:     2drop ;
                    183: 
                    184: : disasm-rd,rt,sa ( addr w -- )
                    185:     dup disasm-rd .
                    186:     dup disasm-rt .
                    187:     dup disasm-shamt .
                    188:     2drop ;
                    189: 
                    190: : disasm-rd,rt,rs ( addr w -- )
                    191:     dup disasm-rd .
                    192:     dup disasm-rt .
                    193:     dup disasm-rs .
                    194:     2drop ;
                    195: 
                    196: : disasm-rs. ( addr w -- )
                    197:     dup disasm-rs .
                    198:     2drop ;
                    199: 
                    200: : disasm-rd,rs ( addr w -- )
                    201:     dup disasm-rd .
                    202:     dup disasm-rs .
                    203:     2drop ;
                    204: 
                    205: : disasm-rd. ( addr w -- )
                    206:     dup disasm-rd .
                    207:     2drop ;
                    208: 
                    209: : disasm-rs,rt ( addr w -- )
                    210:     dup disasm-rs .
                    211:     dup disasm-rt .
                    212:     2drop ;
                    213: 
                    214: : disasm-rd,rs,rt ( addr w -- )
                    215:     dup disasm-rd .
                    216:     dup disasm-rs .
                    217:     dup disasm-rt .
                    218:     2drop ;
                    219: 
                    220: : disasm-rt,rd,z ( addr w -- )
                    221:     dup disasm-rt .
                    222:     dup disasm-rd .
                    223:     dup disasm-copz .
                    224:     2drop ;
                    225: 
1.5       anton     226: : disasm-I-imm,z ( addr w -- )
                    227:     tuck disasm-imm disasm-relative .
                    228:     disasm-copz . ;
1.4       anton     229: 
                    230: \ meta-defining word for instruction format disassembling definitions
                    231: 
                    232: \ The following word defines instruction-format words, which in turn
                    233: \ define anonymous words for disassembling specific instructions and
                    234: \ put them in the appropriate decode table.
                    235: 
                    236: : define-format ( disasm-xt table-xt -- )
                    237:     \ define an instruction format that uses disasm-xt for
                    238:     \ disassembling and enters the defined instructions into table
                    239:     \ table-xt
                    240:     create 2,
                    241: does> ( u "inst" -- )
                    242:     \ defines an anonymous word for disassembling instruction inst,
                    243:     \ and enters it as u-th entry into table-xt
                    244:     2@ swap here name string, ( u table-xt disasm-xt c-addr ) \ remember string
                    245:     noname create 2,      \ define anonymous word
                    246:     execute lastxt swap ! \ enter xt of defined word into table-xt
                    247: does> ( addr w -- )
                    248:     \ disassemble instruction w at addr
                    249:     2@ >r ( addr w disasm-xt R: c-addr )
                    250:     execute ( R: c-addr ) \ disassemble operands
                    251:     r> count type ; \ print name 
                    252: 
                    253: \ all the following words have the stack effect ( u "name" )
                    254: ' disasm-J-target    ' opc-tab-entry    define-format asm-J-target
                    255: ' disasm-I-rs,rt,imm ' opc-tab-entry    define-format asm-I-rs,rt,imm
                    256: ' disasm-I-rs,imm    ' opc-tab-entry    define-format asm-I-rs,imm1
                    257: ' disasm-rt,rs,imm   ' opc-tab-entry    define-format asm-I-rt,rs,imm
1.5       anton     258: ' disasm-rt,rs,uimm   ' opc-tab-entry   define-format asm-I-rt,rs,uimm
                    259: ' disasm-rt,uimm      ' opc-tab-entry   define-format asm-I-rt,uimm
1.4       anton     260: ' disasm-rt,imm,rs   ' opc-tab-entry    define-format asm-I-rt,offset,rs
                    261: ' disasm-rd,rt,sa    ' funct-tab-entry          define-format asm-special-rd,rt,sa
                    262: ' disasm-rd,rt,rs    ' funct-tab-entry          define-format asm-special-rd,rt,rs
                    263: ' disasm-rs.         ' funct-tab-entry          define-format asm-special-rs
                    264: ' disasm-rd,rs       ' funct-tab-entry          define-format asm-special-rd,rs
                    265: ' 2drop              ' funct-tab-entry          define-format asm-special-nothing
                    266: ' disasm-rd.         ' funct-tab-entry          define-format asm-special-rd
                    267: ' disasm-rs,rt       ' funct-tab-entry          define-format asm-special-rs,rt
                    268: ' disasm-rd,rs,rt    ' funct-tab-entry          define-format asm-special-rd,rs,rt
1.15    ! dvdkhlng  269: ' disasm-rd,rs       ' funct-tab2-entry  define-format asm-special2-rd,rs
        !           270: ' disasm-rs,rt       ' funct-tab2-entry  define-format asm-special2-rs,rt
        !           271: ' disasm-rd,rs,rt    ' funct-tab2-entry  define-format asm-special2-rd,rs,rt
1.4       anton     272: ' disasm-I-rs,imm    ' regimm-tab-entry  define-format asm-regimm-rs,imm
                    273: ' 2drop              ' cp0-tab-entry     define-format asm-copz0
                    274: ' disasm-rt,rd,z     ' copz-rs-tab-entry define-format asm-copz-rt,rd1
1.5       anton     275: ' disasm-I-imm,z     ' copz-rt-tab-entry define-format asm-copz-imm1
1.4       anton     276: 
                    277: : asm-I-rs,imm ( u1 u2 "name" -- ; compiled code: addr w -- )
                    278:     nip asm-I-rs,imm1 ;
                    279: 
1.3       anton     280: : asm-copz-rt,rd ( u1 u2 "name" -- )
1.4       anton     281:     drop asm-copz-rt,rd1 ;
1.3       anton     282: 
1.4       anton     283: : asm-copz-rt,offset,rs ( u "name" -- )
                    284:     \ ignore these insts, we disassemble using  asm-I-rt,offset,rs
                    285:     drop name 2drop ;
1.3       anton     286: 
                    287: : asm-copz-imm ( u1 u2 u3 "name" -- )
1.4       anton     288:     drop nip asm-copz-imm1 ;
1.1       anton     289: 
1.3       anton     290: include ./insts.fs
1.8       anton     291: 
                    292: previous set-current

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