File:  [gforth] / gforth / arch / alpha / disasm.fs
Revision 1.5: download - view: text, annotated - select for diffs
Thu Jun 29 16:46:13 2000 UTC (22 years, 1 month ago) by anton
Branches: MAIN
CVS tags: HEAD
Alpha assembler branches now use absolute addresses
Alpha control structures reworked

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

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