File:  [gforth] / gforth / arch / alpha / disasm.fs
Revision 1.9: download - view: text, annotated - select for diffs
Mon Dec 31 19:02:24 2007 UTC (14 years, 7 months ago) by anton
Branches: MAIN
CVS tags: v0-7-0, HEAD
updated copyright year after changing license notice

    1: \ disassembler in forth for alpha
    2: 
    3: \ Copyright (C) 1999,2000,2007 Free Software Foundation, Inc.
    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
    9: \ as published by the Free Software Foundation, either version 3
   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
   18: \ along with this program. If not, see http://www.gnu.org/licenses/.
   19: 
   20: \ contributed by Bernd Thallner
   21: 
   22: \ util
   23: 
   24: \ require asm.fs
   25: 
   26: \  : h@ ( addr -- n )  \ 32 bit fetch
   27: \  dup dup aligned = if
   28: \    @
   29: \    $00000000ffffffff and
   30: \  else
   31: \    4 - @
   32: \    $20 rshift
   33: \  endif
   34: \  ;
   35: 
   36: also assembler
   37: vocabulary disassembler
   38: get-current
   39: also disassembler definitions
   40: 
   41: create string_table
   42: 1000 allot
   43: 
   44: \ makes an table entry with following data structure
   45: \ 64 start address in string_table 48 strlen 32 format (cOpc, cBra, cF-P, cMem, cMfc, cMbr, cOpr, cPcd) 0
   46: 
   47: : mktbentry, { start format straddr strlen -- start }  \ make table entry
   48:   straddr string_table start + strlen cmove
   49:   start 48 lshift
   50:   strlen 32 lshift or
   51:   format or
   52:   ,
   53:   start strlen +
   54: ;
   55: 
   56: \ prints the string from stringtable
   57: \ table_entry = 64 start address in string_table 48 strlen 32 unused 0
   58: 
   59: : print_string ( table_entry -- )  \ print string entry
   60:   dup
   61:   48 rshift string_table +
   62:   swap
   63:   32 rshift $000000000000ffff and
   64:   type
   65: ;
   66: 
   67: \ Opr tab0 opcode 10.xxx
   68: \ Opr tab1 opcode 11.xxx
   69: \ Opr tab2 opcode 12.xxx
   70: \ Opr tab3 opcode 13.xxx
   71: 
   72: \ F-P tab0 opcode 15.xxx
   73: \ F-P tab1 opcode 16.xxx
   74: \ F-P tab2 opcode 17.xxx
   75: 
   76: : tab0 2* 2* ;
   77: : tab1 2* 2* 1 + ;
   78: : tab2 2* 2* 2 + ;
   79: : tab3 2* 2* 3 + ;
   80: 
   81: 0 \ string_table offset
   82: 
   83: create Opr_list
   84: 
   85: $00 tab0 s" addl"          mktbentry,
   86: $40 tab0 s" addlv"         mktbentry,
   87: $20 tab0 s" addq"          mktbentry,
   88: $60 tab0 s" addqv"         mktbentry,
   89: $0f tab0 s" cmpbge"        mktbentry,
   90: $2d tab0 s" cmpeq"         mktbentry,
   91: $6d tab0 s" cmple"         mktbentry,
   92: $4d tab0 s" cmplt"         mktbentry,
   93: $3d tab0 s" cmpule"        mktbentry,
   94: $1d tab0 s" cmpult"        mktbentry,
   95: $02 tab0 s" s4addl"        mktbentry,
   96: $22 tab0 s" s4addq"        mktbentry,
   97: $0b tab0 s" s4subl"        mktbentry,
   98: $2b tab0 s" s4subq"        mktbentry,
   99: $12 tab0 s" s8addl"        mktbentry,
  100: $32 tab0 s" s8addq"        mktbentry,
  101: $1b tab0 s" s8ubl"         mktbentry,
  102: $3b tab0 s" s8ubq"         mktbentry,
  103: $09 tab0 s" subl"          mktbentry,
  104: $49 tab0 s" sublv"         mktbentry,
  105: $29 tab0 s" subq"          mktbentry,
  106: $69 tab0 s" subqv"         mktbentry,
  107: 
  108: $00 tab1 s" and"           mktbentry,
  109: $08 tab1 s" bic"           mktbentry,
  110: $20 tab1 s" bis"           mktbentry,
  111: $24 tab1 s" cmoveq"        mktbentry,
  112: $46 tab1 s" cmovge"        mktbentry,
  113: $66 tab1 s" cmovgt"        mktbentry,
  114: $16 tab1 s" cmovlbc"       mktbentry,
  115: $14 tab1 s" cmovlbs"       mktbentry,
  116: $64 tab1 s" cmovle"        mktbentry,
  117: $44 tab1 s" cmovlt"        mktbentry,
  118: $26 tab1 s" cmovne"        mktbentry,
  119: $48 tab1 s" eqv"           mktbentry,
  120: $28 tab1 s" ornot"         mktbentry,
  121: $40 tab1 s" xor"           mktbentry,
  122: 
  123: $06 tab2 s" extbl"         mktbentry,
  124: $6a tab2 s" extlh"         mktbentry,
  125: $26 tab2 s" extll"         mktbentry,
  126: $7a tab2 s" extqh"         mktbentry,
  127: $36 tab2 s" extql"         mktbentry,
  128: $5a tab2 s" extwh"         mktbentry,
  129: $16 tab2 s" extwl"         mktbentry,
  130: $0b tab2 s" insbl"         mktbentry,
  131: $67 tab2 s" inslh"         mktbentry,
  132: $2b tab2 s" insll"         mktbentry,
  133: $77 tab2 s" insqh"         mktbentry,
  134: $3b tab2 s" insql"         mktbentry,
  135: $57 tab2 s" inswh"         mktbentry,
  136: $1b tab2 s" inswl"         mktbentry,
  137: $02 tab2 s" mskbl"         mktbentry,
  138: $62 tab2 s" msklh"         mktbentry,
  139: $22 tab2 s" mskll"         mktbentry,
  140: $72 tab2 s" mskqh"         mktbentry,
  141: $32 tab2 s" mskql"         mktbentry,
  142: $52 tab2 s" mskwh"         mktbentry,
  143: $12 tab2 s" mskwl"         mktbentry,
  144: $39 tab2 s" sll"           mktbentry,
  145: $3c tab2 s" sra"           mktbentry,
  146: $34 tab2 s" srl"           mktbentry,
  147: $30 tab2 s" zap"           mktbentry,
  148: $31 tab2 s" zapnot"        mktbentry,
  149: 
  150: $00 tab3 s" mull"          mktbentry,
  151: $20 tab3 s" mullq"         mktbentry,
  152: $30 tab3 s" umulh"         mktbentry,
  153: $40 tab3 s" mullv"         mktbentry,
  154: $60 tab3 s" mullqv"        mktbentry,
  155: 
  156: create Mfc_list
  157: 
  158: $0000 s" trapb"            mktbentry,
  159: $0400 s" excb"             mktbentry,
  160: $4000 s" mb"               mktbentry,
  161: $4400 s" wmb"              mktbentry,
  162: $8000 s" fetch"            mktbentry,
  163: $a000 s" fetch_m"          mktbentry,
  164: $c000 s" rpcc"             mktbentry,
  165: $e000 s" rc"               mktbentry,
  166: $f000 s" rs"               mktbentry,
  167: 
  168: create Mbr_table
  169: 
  170: ( 00 ) 0 s" jmp"           mktbentry, 
  171: ( 01 ) 0 s" jsr"           mktbentry,
  172: ( 02 ) 0 s" ret"           mktbentry,
  173: ( 03 ) 0 s" jsr_coroutine" mktbentry,
  174: 
  175: create F-P_list
  176: 
  177: $080 tab0 s" addf"         mktbentry,
  178: $081 tab0 s" subf"         mktbentry,
  179: $082 tab0 s" mulf"         mktbentry,
  180: $083 tab0 s" divf"         mktbentry,
  181: $09e tab0 s" cvtdg"        mktbentry,
  182: $0a0 tab0 s" addg"         mktbentry,
  183: $0a1 tab0 s" subg"         mktbentry,
  184: $0a2 tab0 s" mulg"         mktbentry,
  185: $0a3 tab0 s" divg"         mktbentry,
  186: $0a5 tab0 s" cmpgeq"       mktbentry,
  187: $0a6 tab0 s" cmpglt"       mktbentry,
  188: $0a7 tab0 s" cmpgle"       mktbentry,
  189: $0ac tab0 s" cvtgf"        mktbentry,
  190: $0ad tab0 s" cvtgd"        mktbentry,
  191: $0af tab0 s" cvtgq"        mktbentry,
  192: $0bc tab0 s" cvtqf"        mktbentry,
  193: $0be tab0 s" cvtqg"        mktbentry,
  194: 
  195: $080 tab1 s" adds"         mktbentry,
  196: $081 tab1 s" subs"         mktbentry,
  197: $082 tab1 s" mulls"        mktbentry,
  198: $083 tab1 s" divs"         mktbentry,
  199: $0a0 tab1 s" addt"         mktbentry,
  200: $0a1 tab1 s" subt"         mktbentry,
  201: $0a2 tab1 s" mullt"        mktbentry,
  202: $0a3 tab1 s" divt"         mktbentry,
  203: $0a4 tab1 s" cmptun"       mktbentry,
  204: $0a5 tab1 s" cmpteq"       mktbentry,
  205: $0a6 tab1 s" cmptlt"       mktbentry,
  206: $0a7 tab1 s" cmptle"       mktbentry,
  207: $0ac tab1 s" cvtts"        mktbentry,
  208: $0af tab1 s" cvttq"        mktbentry,
  209: $0bc tab1 s" cvtqs"        mktbentry,
  210: $0be tab1 s" cvtqt"        mktbentry,
  211: $2ac tab1 s" cvtst"        mktbentry,
  212: 
  213: $010 tab2 s" cvtlq"        mktbentry,
  214: $020 tab2 s" cpys"         mktbentry,
  215: $021 tab2 s" cpysn"        mktbentry,
  216: $022 tab2 s" cpyse"        mktbentry,
  217: $024 tab2 s" mt_fpcr"      mktbentry,
  218: $025 tab2 s" mf_fpcr"      mktbentry,
  219: $02a tab2 s" fcmoveq"      mktbentry,
  220: $02b tab2 s" fcmovne"      mktbentry,
  221: $02c tab2 s" fcmovlt"      mktbentry,
  222: $02d tab2 s" fcmovge"      mktbentry,
  223: $02e tab2 s" fcmovle"      mktbentry,
  224: $02f tab2 s" fcmovgt"      mktbentry,
  225: $030 tab2 s" cvtql"        mktbentry,
  226: $130 tab2 s" cvtqlv"       mktbentry,
  227: $530 tab2 s" cvtqlsv"      mktbentry,
  228: 
  229: create register_table
  230: 
  231: ( 00 ) 0 s" v0"           mktbentry,
  232: ( 01 ) 0 s" t0"           mktbentry,
  233: ( 02 ) 0 s" t1"           mktbentry,
  234: ( 03 ) 0 s" t2"           mktbentry,
  235: ( 04 ) 0 s" t3"           mktbentry,
  236: ( 05 ) 0 s" t4"           mktbentry,
  237: ( 06 ) 0 s" t5"           mktbentry,
  238: ( 07 ) 0 s" t6"           mktbentry,
  239: ( 08 ) 0 s" t7"           mktbentry,
  240: ( 09 ) 0 s" s0"           mktbentry,
  241: ( 0a ) 0 s" s1"           mktbentry,
  242: ( 0b ) 0 s" s2"           mktbentry,
  243: ( 0c ) 0 s" s3"           mktbentry,
  244: ( 0d ) 0 s" s4"           mktbentry,
  245: ( 0e ) 0 s" s5"           mktbentry,
  246: ( 0f ) 0 s" fp"           mktbentry,
  247: ( 10 ) 0 s" a0"           mktbentry,
  248: ( 11 ) 0 s" a1"           mktbentry,
  249: ( 12 ) 0 s" a2"           mktbentry,
  250: ( 13 ) 0 s" a3"           mktbentry,
  251: ( 14 ) 0 s" a4"           mktbentry,
  252: ( 15 ) 0 s" a5"           mktbentry,
  253: ( 16 ) 0 s" t8"           mktbentry,
  254: ( 17 ) 0 s" t9"           mktbentry,
  255: ( 18 ) 0 s" t10"          mktbentry,
  256: ( 19 ) 0 s" t11"          mktbentry,
  257: ( 1a ) 0 s" ra"           mktbentry,
  258: ( 1b ) 0 s" t12"          mktbentry,
  259: ( 1c ) 0 s" at"           mktbentry,
  260: ( 1d ) 0 s" gp"           mktbentry,
  261: ( 1e ) 0 s" sp"           mktbentry,
  262: ( 1f ) 0 s" zero"         mktbentry,
  263: 
  264: defer decode_register
  265: 
  266: : decode_register_symb ( register -- )
  267:   cells register_table +
  268:   @ print_string $20 emit
  269: ;
  270: 
  271: : decode_register_number ( register -- )
  272:   .
  273: ;
  274: 
  275: ' decode_register_number is decode_register
  276: \ ' decode_register_symb is decode_register
  277: 
  278: create decode_code
  279: 
  280: : decode_Opc ( instruction tbentry -- )
  281:   print_string drop
  282: ;
  283: 
  284: : decode_Bra ( addr instruction tbentry -- addr )
  285:   swap
  286:   dup $03e00000 and 21 rshift decode_register
  287:   $001fffff and 2* 2* 2 pick + 4 + hex.
  288:   print_string
  289: ;
  290: 
  291: : decode_F-P ( instruction tbentry -- )
  292:   drop
  293:   dup $03e00000 and 21 rshift decode_register
  294:   dup $001f0000 and 16 rshift decode_register
  295:   dup $0000001f and decode_register
  296:   dup 26 rshift $15 -
  297:   swap $0000fff0 and 3 rshift or F-P_list
  298:   begin
  299:     dup @ rot swap over over $00000000ffffffff and
  300:     = if print_string swap drop register_table swap else drop endif
  301:     swap 1 cells + dup register_table >
  302:   until
  303:   drop drop
  304: ;
  305: 
  306: : decode_Mem ( instruction tbentry -- )
  307:   swap
  308:   dup $03e00000 and 21 rshift decode_register
  309:   dup $0000ffff and dup 15 rshift negate 15 lshift or .
  310:   $001f0000 and 16 rshift decode_register
  311:   print_string
  312: ;
  313: 
  314: : decode_Mfc ( instruction tbentry -- )
  315:   drop
  316:   dup $03e00000 and 21 rshift decode_register
  317:   dup $001f0000 and 16 rshift decode_register
  318:   $0000ffff and Mfc_list
  319:   begin
  320:     dup @ rot swap over over $00000000ffffffff and
  321:     = if print_string drop drop register_table 1 else drop endif
  322:     swap 1 cells + dup F-P_list >
  323:   until
  324:   drop drop
  325: ;
  326: 
  327: : decode_Mbr ( instruction tbentry -- )
  328:   drop
  329:   dup $03e00000 and 21 rshift decode_register
  330:   dup $001f0000 and 16 rshift decode_register
  331:   dup $00003fff and decode_register
  332:   $0000c000 and 14 rshift cells Mbr_table +
  333:   @ print_string
  334: ;
  335: 
  336: : decode_Opr ( instruction tbentry -- )
  337:   drop
  338:   dup $03e00000 and 21 rshift decode_register
  339:   dup dup $00001000 and $00001000
  340:   = if
  341:     $001fe000 and 13 rshift . -1
  342:   else
  343:     $001f0000 and 16 rshift decode_register 0
  344:   endif
  345:   swap dup $0000001f and decode_register
  346:   dup 26 rshift $10 -
  347:   swap $00000fe0 and 3 rshift or Opr_list
  348:   begin
  349:     dup @ rot swap over over $00000000ffffffff and
  350:     = if print_string swap drop register_table swap else drop endif
  351:     swap 1 cells + dup Mfc_list >
  352:   until
  353:   drop drop if $23 emit endif
  354: ;
  355: 
  356: : decode_Pcd ( instruction tbentry -- )
  357:   swap
  358:   $0000000003ffffff and .
  359:   print_string
  360: ;
  361: 
  362: \ format
  363: 
  364: ' decode_Opc decode_code - constant cOpc
  365: ' decode_Bra decode_code - constant cBra
  366: ' decode_F-P decode_code - constant cF-P
  367: ' decode_Mem decode_code - constant cMem
  368: ' decode_Mfc decode_code - constant cMfc
  369: ' decode_Mbr decode_code - constant cMbr
  370: ' decode_Opr decode_code - constant cOpr
  371: ' decode_Pcd decode_code - constant cPcd
  372: 
  373: create opcode_table
  374: 
  375: ( 00 ) cPcd s" call_pal" mktbentry,
  376: ( 01 ) cOpc s" opc01"       mktbentry,
  377: ( 02 ) cOpc s" opc02"       mktbentry,
  378: ( 03 ) cOpc s" opc03"       mktbentry,
  379: ( 04 ) cOpc s" opc04"       mktbentry,
  380: ( 05 ) cOpc s" opc05"       mktbentry,
  381: ( 06 ) cOpc s" opc06"       mktbentry,
  382: ( 07 ) cOpc s" opc07"       mktbentry,
  383: ( 08 ) cMem s" lda"         mktbentry,
  384: ( 09 ) cMem s" ldah"        mktbentry,
  385: ( 0a ) cOpc s" opc0a"       mktbentry,
  386: ( 0b ) cMem s" ldq_u"       mktbentry,
  387: ( 0c ) cOpc s" opc0c"       mktbentry,
  388: ( 0d ) cOpc s" opc0d"       mktbentry,
  389: ( 0e ) cOpc s" opc0e"       mktbentry,
  390: ( 0f ) cMem s" stq_u"       mktbentry,
  391: ( 10 ) cOpr s" "            mktbentry,
  392: ( 11 ) cOpr s" "            mktbentry,
  393: ( 12 ) cOpr s" "            mktbentry,
  394: ( 13 ) cOpr s" "            mktbentry,
  395: ( 14 ) cOpc s" opc14"       mktbentry,
  396: ( 15 ) cF-P s" "            mktbentry,
  397: ( 16 ) cF-P s" "            mktbentry,
  398: ( 17 ) cF-P s" "            mktbentry,
  399: ( 18 ) cMfc s" "            mktbentry,
  400: ( 19 ) cOpc s" pal19"       mktbentry,
  401: ( 1a ) cMbr s" "            mktbentry,
  402: ( 1b ) cOpc s" pal1b"       mktbentry,
  403: ( 1c ) cOpc s" opc1c"       mktbentry,
  404: ( 1d ) cOpc s" pal1d"       mktbentry,
  405: ( 1e ) cOpc s" pal1e"       mktbentry,
  406: ( 1f ) cOpc s" pal1f"       mktbentry,
  407: ( 20 ) cMem s" ldf"         mktbentry,
  408: ( 21 ) cMem s" ldg"         mktbentry,
  409: ( 22 ) cMem s" lds"         mktbentry,
  410: ( 23 ) cMem s" ldt"         mktbentry,
  411: ( 24 ) cMem s" stf"         mktbentry,
  412: ( 25 ) cMem s" stg"         mktbentry,
  413: ( 26 ) cMem s" sts"         mktbentry,
  414: ( 27 ) cMem s" stt"         mktbentry,
  415: ( 28 ) cMem s" ldl"         mktbentry,
  416: ( 29 ) cMem s" ldq"         mktbentry,
  417: ( 2a ) cMem s" ldl_l"       mktbentry,
  418: ( 2b ) cMem s" ldq_l"       mktbentry,
  419: ( 2c ) cMem s" stl"         mktbentry,
  420: ( 2d ) cMem s" stq"         mktbentry,
  421: ( 2e ) cMem s" stl_c"       mktbentry,
  422: ( 2f ) cMem s" stq_c"       mktbentry,
  423: ( 30 ) cBra s" br"          mktbentry,
  424: ( 31 ) cBra s" fbeq"        mktbentry,
  425: ( 32 ) cBra s" fblt"        mktbentry,
  426: ( 33 ) cBra s" fble"        mktbentry,
  427: ( 34 ) cBra s" bsr"         mktbentry,
  428: ( 35 ) cBra s" fbne"        mktbentry,
  429: ( 36 ) cBra s" fbge"        mktbentry,
  430: ( 37 ) cBra s" fbgt"        mktbentry,
  431: ( 38 ) cBra s" blbc"        mktbentry,
  432: ( 39 ) cBra s" beq"         mktbentry,
  433: ( 3a ) cBra s" blt"         mktbentry,
  434: ( 3b ) cBra s" ble"         mktbentry,
  435: ( 3c ) cBra s" blbs"        mktbentry,
  436: ( 3d ) cBra s" bne"         mktbentry,
  437: ( 3e ) cBra s" bge"         mktbentry,
  438: ( 3f ) cBra s" bgt"         mktbentry,
  439: 
  440: drop \ string_table end
  441: 
  442: set-current
  443: 
  444: : disasm-inst ( addr n -- addr )  \ instruction decoder
  445:   dup $fc000000 and
  446:   26 rshift cells
  447:   opcode_table +
  448:   @ dup $00000000ffffffff and
  449:   decode_code + execute
  450:   $2c emit cr
  451: ;
  452: 
  453: : disasm ( addr u -- )  \ gforth
  454:     \G disassemble u aus starting at addr
  455:     cr bounds
  456:     u+do
  457: 	." ( " i hex. ." ) "
  458: 	i i h@ disasm-inst drop
  459: 	4
  460:     +loop ;
  461: 
  462: ' disasm is discode
  463: 
  464: previous previous

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